Light ROM 1/LIGHT-ROM 1 (Amiga Library Services)(1994).iso/ffdisks/d949.lha/BBBBS/BBBBS65.lha/rexx/bbsLOCAL.rexx

OS/2 REXX Batch file | 1993-10-31 | 166KB | 6,039 lines

/* $VER: bbsLOCAL.rexx 6.5 © 1993 Richard Lee Stockton 7:56PM (31.10.93)
        - FREELY DISTRIBUTABLE AS LONG AS THIS NOTICE REMAINS -

                BBBBS.baud without the BaudBandit stuff
       Will multi-task with BBBBS.baud (within limits, see docs)
     THIS IS THE SYSOP'S VERSION OF BBBBS.baud FOR LOCAL USE ONLY!
*/

copyright.=''
copyright.1=STRIP(SUBSTR(SOURCELINE(1),10))
copyright.2='
from Gramma Software 21305-60th Ave West, Mountlake Terrace WA 98043-2009'
copyright.3='
ARexx portions of this software copyright 1990-93 Richard Lee Stockton'
copyright.4='- FREELY DISTRIBUTABLE as long as this notice remains -'

/* If the QuickSortPort not found then try to run setup.rexx */

IF ~show('P','QuickSortPort') THEN CALL setup.rexx()
IF ~show('P','QuickSortPort') THEN EXIT

IF SHOW('P','BBBBS_LOCAL') THEN
  DO
    SAY 'bbsLOCAL.rexx is already running!'
    EXIT 0
  END
IF SHOW('P','BBBBS') & GETCLIP('BBS_maint')~='' THEN
  DO
    SAY 'BBS_maint flag is set. Wait until processing is finished, then restart.'
    EXIT 0
  END
CALL SETCLIP('BBS_mainfiles')
CALL SETCLIP('BBS_mainusers')
CALL OPENPORT('BBBBS_LOCAL')

PARSE VERSION . . cpu .
cpu=RIGHT(cpu,2)/10
IF cpu<1 THEN cpu=1

/* BBS Directories (may be created with SETUP option) */
bbs.=''
bbs.1='Information' /* text files from sysop for the user to read */
bbs.6='Scratch'
bbs.7='BBS_HELP'
bbs.8='rexxDoors'
bbs.9='BBS_TEXT'    /* text files for BBS use. WELCOME HELLO, NEW etc. */
bbs.10='FileNotes'
bbs.11='BBS_LIBS'
bbs.12='BBS_MSGS'
bbs.13='Lists'
bbs.14='Numbers'    /* 1st & last messages, mail, files */
bbs.15='Usage'
bbs.16='Logs'
bbs.17='EMailFiles'
bbs.18='EMail'
bbs.19='Users'


/* VARIABLES */

bbsprefs.=0 /* start with all prefs OFF */
alpha.=''
lastread.=0
dirnum=1
linesperpage=20
sortuserflag=0
sortalphaflag=0
savefileflag=0
emailonline=-1
level=0
lastread.=0
totwrit.=0
lastbrowse=0
warnings=0
winnings=0
nonstop=0
newfilesdate=''
newpassword=''
replysubj=''
msgdir=1
menuflag=1
logonflag=1
data.=''


/* TEXT - User data structure by line */

text.=''
text.1='   Full Name'
text.2='      Street'
text.3='City, ST Zip'
text.4=' Voice Phone'
text.5='    Password'
text.6='    Protocol'
text.7='LinesPerPage'
text.8=' Preferences'
text.9='    Computer'
text.10='   Interests'
text.11='Session Time'
text.12='FirstSession'
text.13='Last Session'
text.14='      UpLoad'
text.15='    Download'
text.16='   Last File'
text.17='Ratio  Email'
text.18='    Winnings'
text.19='       Usage'
text.20='       Level'
text.21='Exclude DIRS'
text.22='   Msgs Read'
text.23='   Msgs Writ'
text.24=' Marked Msgs'
text.25='Marked Files'
text.26='QUICKexclude'
text.27=' CBV numbers'


/* try to trap everything */

SIGNAL ON BREAK_C
OPTIONS RESULTS
OPTIONS FAILAT 999999
SIGNAL ON BREAK_E
SIGNAL ON SYNTAX
SIGNAL ON FAILURE
NUMERIC DIGITS 14


ARG option .

SAY CENTER(copyright.1,75)
CALL config()

IF ~EXISTS(bbspath'Numbers/FirstLogon') THEN
  ADDRESS COMMAND 'C:Date >'bbspath'Numbers/FirstLogon'

SAY CENTER(copyright.2,75)
SAY CENTER(copyright.3,75)
SAY CENTER(copyright.4,75)
SAY


IF option='SETUP' THEN
  DO
    SAY 'Making sure all needed directories are here...'
    DO i=1 TO 20
      IF bbs.i~='' THEN CALL MAKEDIR(bbspath||bbs.i)
    END
  END

CALL colors(1)

msg.=''
IF readopen(bbspath'Lists/Conferences') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' THEN BREAK
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN msg.num=WORD(line,2)
    END
    CALL CLOSE(f)
  END
IF option='SETUP' THEN
  DO
    DO i=1 TO 99
      IF msg.i~='' THEN CALL MAKEDIR(msgpath||i)
    END
  END

courtesy=''
IF EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          courtesy=courtesy line
        END
        CALL CLOSE(f)
      END
  END

dirs.=''
IF readopen(bbspath'Lists/Libraries') THEN
  DO
    DO i=1
      line=READLN(f)
      IF line='END' | EOF(f) THEN LEAVE i
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN dirs.num=STRIP(WORD(line,2))
    END
    CALL CLOSE(f)
  END
IF option='SETUP' THEN
  DO
    SAY 'Making sure all file library directories are here...'
    DO i=1 TO 99
      IF dirs.i~='' THEN
        DO
          CALL MAKEDIR(libpath||dirs.i)
          CALL MAKEDIR(bbspath'FileNotes/'dirs.i)
        END
    END
  END

CALL loaduserlist()
SAY '          The larger the BBS gets, the longer the setup takes...'

files.=''
IF readopen(bbspath'Lists/Files') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
    END
    files.0=i-1
    CALL CLOSE(f)
  END

IF readopen(bbspath'Lists/Files.ALPHA') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      alpha.i=line
      fnum=WORD(line,3)
      files.fnum.0=i
    END
    alpha.0=i-1
    CALL CLOSE(f)
  END

CALL set_grand()

BIG_LOOP:
/** Identify (title) message */
IF EXISTS(bbspath'BBS_TEXT/HELLO') THEN
  DO
    SAY
    arg=bbspath'BBS_TEXT/HELLO'
    CALL readlines(arg 1)
    CALL seelines(0)
  END
SAY
SAY pen3'Courtesy List:'def
SAY courtesy
SAY


/* Ask for name */
name=''
DO count=1 TO 3
  name=getinput(1 0 'Please enter name: ')
  name=SPACE(name,1,'_')
  IF name='NEW' THEN LEAVE count
  IF name~='' THEN
    DO
      IF FIND(userlist,name)>0 THEN LEAVE count
      IF FIND(exclusion,name)>0 THEN
        DO
          SAY 'Sorry, that is a reserved name.'
          name=''
          ITERATE count
        END
      IF bbsprefs.7>0 | FIND(courtesy,name)>0 THEN
        DO
          SAY
          SAY 'Welcome' name'!'
          SAY 'You will be automatically validated after you enter your user info.'
          SAY
          LEAVE count
        END
    END
  IF count<3 THEN SAY 'New Users please enter NEW to apply for validation.'
END
IF count>3 THEN SIGNAL DONE
CALL checkUser()
IF UPPER(WORD(data.12,3))~='BIRTHDAY:' THEN
  DO
    SAY
    SAY 'Please help us out by entering the following information.'
    CALL getbirth()
    SAY '   Thank you!'
  END
CALL checkclips()
city=docity(data.3)

CALL TIME('R')

IF RIGHT(WORD(data.12,4),4)=RIGHT(DATE('S'),4) THEN
  DO
    arg=bbspath'BBS_TEXT/BIRTHDAY'
    IF EXISTS(arg) THEN
      DO
        SAY
        CALL showtext(arg)
      END
    SAY
    SAY '***  Happy Birthday,' pen3||data.1||def', and many more!  ***'
    SAY
  END
SAY

CALL bbsLOGON.baud(name level)
CALL sortlibraries()
IF FIND(data.8,'QUICK')>0 THEN CALL do_quick(0)


/* Opening Display after logon. Seen by all Users ONCE A DAY. It first  */
/* looks for a unique yearly data (ie, WELCOME.0704), then daily data   */
/* (ie, WELCOME.Fri), and finally a simple, everyday 'WELCOME' datafile */

IF DATE('I')>lastondate THEN
  DO
    SAY
    arg=bbspath'BBS_TEXT/WELCOME.'RIGHT(DATE('S'),4)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY
    arg=bbspath'BBS_TEXT/WELCOME.'LEFT(DATE('W'),3)
    IF EXISTS(arg) THEN CALL showtext(arg)
    SAY
    arg=bbspath'BBS_TEXT/WELCOME'
    IF EXISTS(arg) THEN CALL showtext(arg)

/*
Looks for format UNTIL.YYYYMMDD ie, "UNTIL.19920514"
Deletes any that are previous to "today"
*/

    untils.=''
    IF FileList(bbspath'BBS_TEXT/UNTIL.*',untils)>0 THEN
      DO
        CALL QSORT(1,untils.0,untils)
        DO ui=1 TO untils.0
          IF RIGHT(untils.ui,8)<DATE('S') THEN CALL DELETE(untils.ui)
          ELSE
            DO
              SAY
              CALL showtext(untils.ui)
            END
        END
      END
    DROP untils.
  END

IF bbsprefs.1 & ~terseflag THEN
  DO
    IF doGrin()>3 THEN CALL waiting()
    IF EXISTS(bbspath'rexxDoors/Moon.rexx') THEN CALL Moon.rexx()
    IF EXISTS(bbspath'rexxDoors/Time.rexx') THEN CALL Time.rexx()
    IF FIND(UPPER(SHOWLIST('A')),'TODAY')>0 THEN
      DO
        IF EXISTS('RAM:TODAY') THEN
          DO
            finfo=STATEF('RAM:TODAY')
            IF WORD(finfo,5)~=DATE('I') THEN
              ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
          END
        ELSE ADDRESS COMMAND 'C:Today091 >RAM:TODAY'
        IF EXISTS('RAM:TODAY') THEN
          DO
            CALL readlines('RAM:TODAY' 1)
            CALL seelines(0)
          END
      END
    SAY
  END

CALL readmail(0)
IF ~terseflag THEN
  DO
    IF level>sysoplevel THEN
      DO
        lstmail=WORD(data.17,3)
        IF ~DATATYPE(lstmail,'W') THEN lstmail=0
        IF countcheck(bbspath'Numbers/LastMail' 0)>lstmail THEN
          IF getinput(1 1 'Check Email? (Ny) > ')='Y' THEN CALL mailreport()
        IF level<99 THEN
          DO
            SAY
            CALL showtext(bbspath'Email/'sysop'/NEW_FILES')
          END
        SAY
        CALL showtext(bbspath'Lists/NEW_USERS')
        CALL showtext(bbspath'Lists/CBV_USERS')
      END
    CALL logonstats()
    CALL newinfo()
  END
CALL showmarked(1)
CALL setdir(libpath||dirs.1)
logonflag=0


/***** MAIN *****/

IF menu~='ALL' THEN menu='MAIN'

RESTART:
SIGNAL ON BREAK_C
SIGNAL ON BREAK_E

waitchar=''
string=''
opt=''
IF level<1 THEN menu='NEW'
DO WHILE(opt~='G')
  go=0
  DO WHILE(~go)
    IF waitchar='' | waitchar='?' THEN
      DO
        commands='cghiqsvwxyz!#,'
        IF level>0  THEN commands='abcdefghijlmnoprstuvwxyz!$#&.,+'
        IF level>sysoplevel THEN commands=commands'k%^()=;'
        IF level=99 THEN commands=commands'@~'
        commands=commands'?'
        IF menuflag | waitchar='?' | string='?' THEN
          DO
            opt='MENU'
            arg=''
            CALL menus()
          END
        ELSE SAY pen3'COMMANDS:'def commands
      END
    line=''
    line=line||bak2' 'TIME('C')' 'def
    IF menu='ALL' | menu='FILE' THEN
      line=line pen3'FILE_LIBRARY:'plaindir||def
    ELSE IF menu='MSG' THEN line=line pen3'MESSAGES:'def
    ELSE line=line pen3'MAIN:'def
    line=line'  'bbsname
    IF waitchar='' THEN waitchar=getinput(0 0 line' > ')
    PARSE VAR waitchar string' 'arg
    nonstop=0
    string=UPPER(STRIP(string))
    IF string='OFF' | string='BYE' THEN SIGNAL LOGOUT
    IF string='FL' & level>0 THEN CALL Friends()
    CALL checkalias()
    waitchar=''
    IF DATATYPE(string,'W') THEN
      DO
        IF string>level THEN
          DO
            arg=STRIP(string arg)
            string='D'
          END
        ELSE
          DO
            dirnum=string
            CALL chdir2()
            CALL since()
          END
      END
    IF string='QUICK' & level>0 THEN CALL do_quick(1)
    opt=left(string,1)
    go=1
    IF POS(opt,UPPER(commands))=0 THEN go=0
  END
  OPTIONS PROMPT 'Filename: '
  SELECT
    WHEN opt='A' THEN CALL showalpha()
    WHEN opt='B' THEN CALL browse()
    WHEN opt='C' THEN CALL editor('MAIL' sysop)
    WHEN opt='D' THEN CALL dload()
    WHEN opt='E' THEN CALL readmail(1)
    WHEN opt='F' THEN CALL do_F()
    WHEN opt='H' THEN CALL help('MAIN')
    WHEN opt='I' THEN CALL information()
    WHEN opt='J' THEN CALL jump2rexx()
    WHEN opt='K' THEN CALL killuser()
    WHEN opt='L' THEN CALL list()
    WHEN opt='M' THEN IF menu~='ALL' THEN menu='MSG'
    WHEN opt='N' THEN CALL newfiles()
    WHEN opt='O' THEN CALL otheruser()
    WHEN opt='P' THEN CALL editor('MSG')
    WHEN opt='R' THEN CALL readmessages()
    WHEN opt='S' THEN CALL bbsSEARCH()
    WHEN opt='U' THEN CALL uload(1)
    WHEN opt='V' THEN CALL showtext(bbspath'Usage/USER.LOG')
    WHEN opt='W' THEN CALL showuserlist()
    WHEN opt='X' THEN CALL switchmenuflag()
    WHEN opt='Y' THEN CALL edituser()
    WHEN opt='Z' THEN CALL counts()
    WHEN opt='~' THEN CALL sysED(1)
    WHEN opt='@' THEN CALL shell()
    WHEN opt='#' THEN CALL switchcolors()
    WHEN opt='$' THEN IF menu='ALL' THEN menu='MAIN'; ELSE menu='ALL'
    WHEN opt='%' THEN CALL editnote()
    WHEN opt='^' THEN CALL readlogs()
    WHEN opt='&' THEN CALL profiles()
    WHEN opt=';' THEN CALL changename()
    WHEN opt='(' THEN CALL filereport()
    WHEN opt=')' THEN CALL mailreport()
    WHEN opt='=' THEN CALL levelreport()
    WHEN opt='+' THEN CALL ext_dload()
    WHEN opt='.' THEN menu='MAIN'
    WHEN opt=',' THEN DO;CALL hourly();CALL waiting();END
    WHEN opt='?' & menuflag THEN CALL help('MAIN')
    OTHERWISE NOP
  END
END
SIGNAL LOGOUT
EXIT



/* FUNCTIONS */


do_F:
IF menu='FILE' | menu='ALL' THEN
  DO
    IF STORAGE()<(bbsprefs.15+100000) | GETCLIP('BBS_libs.0')~='' THEN
      DO
        SAY
        SAY 'Sorry! Not enough memory left for background archiving.'
        SAY 'Please try again in 10 minutes or so.'
        SAY
        RETURN
      END
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i,libs.i)
    END
    IF Make_BrowseList.baud(name colorflag files.0)=0 THEN
      IF emailonline>=0 THEN emailonline=emailonline+1
    DO i=0 TO libs.0
      CALL SETCLIP('BBS_libs.'i)
    END
  END
ELSE IF menu~='ALL' THEN menu='FILE'
RETURN


cleanstring:
PARSE ARG nflag':'cstr
bot=TRIM(XRANGE(,' '))
bot=COMPRESS(bot,'1B'x)  /* ESC for ANSI */
top=XRANGE('7F'x)
IF nflag=1 THEN
  DO
    bot=bot||XRANGE('!','@')'[\]`~{:}'
    cstr=TRANSLATE(UPPER(cstr),' ','_')
  END
cstr=COMPRESS(cstr,bot||top)
IF nflag~=2 THEN cstr=STRIP(cstr)
IF nflag=1 THEN cstr=SPACE(cstr,1,'_')
RETURN cstr


showtext:
PARSE ARG arg .
IF EXISTS(arg) THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
RETURN


doGrin:
IF ~EXISTS(bbspath'rexxDoors/Grin_du_Jour.rexx') THEN RETURN 0
CALL setdir(bbspath'rexxDoors')
temp=Grin_du_Jour.rexx()
SAY
RETURN temp


do_quick:
ARG flag .
IF FIND(UPPER(data.8),'QUICK')=0 THEN
  DO
    SAY
    SAY 'The QUICK option is OFF in your current settings.'
    SAY
    SAY 'Setting the QUICK option to ON will allow you to tell the BBS to'
    SAY 'make a .lha archive of all new bbs activity since your last call.'
    SAY
    SAY 'This archive can then be read (and replied to, and files can be'
    SAY 'uploaded and downloaded) using 'pen3'bbsQUICK.rexx'def', the offline read/reply'
    SAY 'module for BBBBS, which is available here in the file libraries.'
    SAY
    IF getinput(1 1 'Turn the QUICK option ON? (Ny) > ')~='Y' THEN RETURN
    data.8=data.8 'QUICK'
    CALL saveData(0)
  END
ELSE IF flag=1 THEN
  DO
    IF getinput(1 1 'Turn the QUICK option OFF? (Ny) > ')='Y' THEN
      DO
        temp=data.8
        data.8=''
        DO i=1 TO WORDS(temp)
          IF WORD(temp,i)~='QUICK' THEN data.8=STRIP(data.8 WORD(temp,i))
        END
        ADDRESS COMMAND 'c:delete' bbspath'EmailFiles/'name'/QUICK_#?'
        RETURN
      END
  END
IF getinput(1 1 'Edit your QUICK exclude list? (Ny) > ')='Y' THEN
  DO
    SAY
    SAY 'You may EXCLUDE any of these from your QUICK archives.'
    SAY pen3||LEFT('-',74,'-')||def
    temp=LEFT(' ',7)
    SAY temp'HELLO          - Pre-logon message.'
    SAY temp'WELCOME        - Post-logon message.'
    SAY temp'GOODBYE        - Logoff message.'
    SAY temp'HOURLY         - Average-Minutes-Per-Hour usage graph.'
    SAY temp'STATS.BBS      - Most of the Z command from the main menu.'
    SAY temp'filename       - ANY filename in the Information area.'
    SAY temp'MESSAGES       - New conference messages.'
    SAY temp'FILELIST       - New file descriptions.'
    SAY pen3||LEFT('-',74,'-')||def
    SAY 'Enter a space separated list of what you wish to exclude.'
    SAY pen3'Exclude:'def data.26
    temp=getinput(1 0 pen3'Exclude: 'def)
    IF temp='' & data.26~='' THEN
      DO
        IF getinput(1 1 'Clear the QUICK exclude list? (nY) > ')~='N' THEN
          data.26=''
      END
    ELSE data.26=temp
    temp='Your QUICK archives will exclude'pen3
    IF data.26='' THEN temp=temp 'nothing!'
    ELSE temp=temp data.26
    SAY temp||def
    CALL savedata(0)
    SAY
  END
IF GETCLIP('BBS_'name)~='' THEN
  DO
    SAY
    SAY 'The QUICK routines are still working on your archive...'
    SAY 'Please try again later.'
    SAY
    RETURN
  END
quickdir=bbspath'EmailFiles/'name
CALL MAKEDIR(quickdir)
CALL setdir(quickdir)
IF getinput(1 1 'Do you have a QUICKIN file to upload? (Ny) > ')='Y' THEN
  DO
    arg='QUICKIN.lha'
    ul=2
    DO WHILE ul=2
      ul=uload(0)
    END
  END
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') & level>=sysoplevel THEN
  IF getinput(1 1 'Process your QUICKIN archive [N]ow or at [L]ogoff? (Ln) > ')='N' THEN
    DO
      SAY
      SAY 'Please wait, processing QUICKIN archive...'
      CALL bbsQUICKIN.rexx(name level sysoplevel bbsprefs.6)
      CALL checkclips()
      CALL loadData()
      SAY
    END
IF GETCLIP('BBS_'name)='QUICK' THEN
  DO
    SAY
    SAY 'The QUICK routines are still working on your file(s)...'
    SAY
    RETURN
  END
arg='RAM:dirlist'
ADDRESS COMMAND 'C:list >'arg quickdir'/QUICK_#? DATES'
IF WORD(STATEF(arg),2)>80 THEN
  DO
    CALL readlines(arg 1)
    CALL seelines(0)
    SAY
  END
efiles=UPPER(SHOWDIR(quickdir))
DO qi=1 TO WORDS(efiles)
  qarg=WORD(efiles,qi)
  IF LEFT(qarg,6)='QUICK_' & RIGHT(qarg,4)='.LHA' THEN
    DO
      SAY qarg 'is' WORD(STATEF(qarg),2) 'bytes.'
      arg=qarg
      DO WHILE dload()=1
      END
      t=''
      DO WHILE t~='N' & t~='Y'
        t=getinput(1 1 'Delete' qarg'? (ny) > ')
      END
      IF t='Y' THEN
        DO
          IF DELETE(quickdir'/'qarg)=1 THEN SAY qarg 'deleted.'
          CALL DELETE(quickdir'/'qarg'.xdl')
          qarg=COMPRESS(UPPER(qarg),'QUICK_.LHA')
          CALL DELETE(bbspath'Email/'name'/BBBBS.'qarg)
        END
    END
END
arg=''
SAY
IF GETCLIP('BBS_'name)~='' THEN RETURN
IF getinput(1 1 'Archive new BBS activity now? (Ny) > ')='Y' THEN
  DO
    CALL SETCLIP('BBS_city',city)
    CALL SETCLIP('BBS_'name'_26',data.26)
    IF FIND(UPPER(data.26),'STATS.BBS')=0 THEN
      CALL SETCLIP('BBS_statsarg',emailonline grand grand2 files.0)
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      CALL SETCLIP('BBS_'name'_22',data.22)
    CALL MAKEDIR(bbspath'EmailFiles/'name)
    CALL showmarked(0)
    ADDRESS AREXX bbsQUICKOUT.rexx name level lastbrowse WORD(data.16,2) data.21
    IF FIND(UPPER(data.26),'MESSAGES')=0 THEN
      DO
        clear_marked=1
        DO i=1 TO level
          IF WORD(data.22,i)~=-1 THEN
            lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
        END
        SAY
      END
    IF FIND(UPPER(data.26),'FILELIST')=0 THEN
      lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
    newfilesdate=DATE('S') TIME()
    IF writeopen(bbspath'EmailFiles/'name'/Libraries') THEN
      DO
        DO i=1 TO libs.0
          CALL WRITELN(f,libs.i)
        END
        CALL CLOSE(f)
      END
    IF writeopen(bbspath'EmailFiles/'name'/Conferences') THEN
      DO
        DO i=1 TO msgs.0
          CALL WRITELN(f,msgs.i)
        END
        CALL CLOSE(f)
      END
    SAY
    IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN
      DO
        SAY 'Your archive will be waiting next time you call...'
        SAY
        SIGNAL LOGOUT2
      END
    SAY
    SAY 'Note: You now have no ''new'' files or messages (they are being archived).'
    SAY
    CALL saveData(1)
    CALL waiting()
  END
ELSE
  DO
    SAY
    IF getinput(1 1 'Logoff Now? (nY) > ')~='N' THEN SIGNAL LOGOUT2
  END
SAY
RETURN


killuser:
IF level<=sysoplevel THEN RETURN
killcount=0
DO loop=1
  IF arg='' THEN
    DO
      OPTIONS PROMPT 'RETURN=QUIT  Username to Kill: '
      PULL arg
    END
  IF STRIP(arg)='' THEN LEAVE loop
  arg=UPPER(arg)
  arg=SPACE(STRIP(arg),1,'_')
  IF getinput(1 1 'Really kill' arg'? (nY) > ')='N' THEN
    DO
      arg=''
      ITERATE loop
    END
  SAY 'Working...'
  IF readlines(bbspath'Users/'arg 1) THEN
    DO
      SAY 'User' arg 'not found.'
      arg=''
      ITERATE loop
    END
  IF level<=lynes.20 THEN
    DO
      SAY '*** Tsk! Tsk!  Your level is not greater than' arg'.'
      arg=''
      ITERATE loop
    END
  CALL DELETE(bbspath'Users/'arg)
  IF EXISTS(bbspath'Email/'arg) THEN
    DO
      temp=WORDS(SHOWDIR(bbspath'Email/'arg))
      emailonline=emailonline-temp
      ADDRESS COMMAND 'C:DELETE >*' bbspath'Email/'arg 'ALL'
    END
  IF EXISTS(bbspath'EmailFiles/'arg) THEN
    ADDRESS COMMAND 'C:DELETE >*' bbspath'EmailFiles/'arg 'ALL'
  SAY 'User file, Email & EmailFiles for' arg 'have been deleted.'
  killcount=killcount+1
  arg=''
END
IF killcount=0 THEN RETURN
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
RETURN


menus:
SAY
IF menu='NEW' THEN
  DO
    SAY pen6'     _________________'def
    SAY pen6'  __/  'pen3'New User Menu'pen6'  \___'def
    SAY pen6' |                        |'def
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def
    SAY pen6' |'def'   ['pen3'I'def']nformation        'pen6'|'def
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def
    SAY pen6' |'def'   ['pen3'W'def']ho is here        'pen6'|'def
    SAY pen6' |'def'   ['pen3'S'def']earch user list   'pen6'|'def
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def
    SAY pen6' |'def'   ['pen3'X'def'] toggle menus     'pen6'|'def
    SAY pen6' |'def'   ['pen3'#'def'] toggle color     'pen6'|'def
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP   'pen6'|'def
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP   'pen6'|'def
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def
    SAY pen6' |________________________|'def
  END
ELSE IF menu='MSG' THEN
  DO
    SAY pen6'       ____________'def
    SAY pen6'  ____/  'pen3'Messages'pen6'  \_____'def
    SAY pen6' |                       |'def
    SAY pen6' |'def'   ['pen3'H'def']elp              'pen6'|'def
    SAY pen6' |'def'   ['pen3'P'def']ost messages     'pen6'|'def
    SAY pen6' |'def'   ['pen3'R'def']ead messages     'pen6'|'def
    SAY pen6' |'def'   ['pen3'S'def']earch messages   'pen6'|'def
    SAY pen6' |'def'   ['pen3'E'def']mail (private)   'pen6'|'def
    SAY pen6' |'def'   ['pen3'C'def']omment to SYSOP  'pen6'|'def
    SAY pen6' |'def'   ['pen3'QUICK'def'] options     'pen6'|'def
    SAY pen6' |'def'   ['pen3'FL'def'] Friends List   'pen6'|'def
    SAY pen6' |'def'   ['pen3'!'def'] YELL for SYSOP  'pen6'|'def
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'^'def'] view BBS logs   'pen6'|'def
    SAY pen6' |'def'   ['pen3')'def'] email report    'pen6'|'def
    SAY pen6' |'def'   ['pen3'='def'] level report    'pen6'|'def
    SAY pen6' |'def'   ['pen3';'def'] change username 'pen6'|'def;END
IF(level=99) THEN DO
    SAY pen6' |'def'   ['pen3'~'def'] online editor   'pen6'|'def
    SAY pen6' |'def'   ['pen3'@'def'] dos shell       'pen6'|'def;END
    SAY pen6' |'def'   ['pen3'F'def']iles menu        'pen6'|'def
    SAY pen6' |'def'   ['pen3'.'def'] main menu       'pen6'|'def
    SAY pen6' |_______________________|'def
  END
ELSE IF menu='FILE' THEN
  DO
    SAY pen6'         _________'def
    SAY pen6'  ______/  'pen3'Files'pen6'  \_______'def
    SAY pen6' |                        |'def
    SAY pen6' |'def'   ['pen3'A'def']lphabetic list    'pen6'|'def
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def
    SAY pen6' |'def'   ['pen3'B'def']rowse filenotes   'pen6'|'def
    SAY pen6' |'def'   ['pen3'N'def']ew files list     'pen6'|'def
    SAY pen6' |'def'   ['pen3'L'def']ist by Library    'pen6'|'def
    SAY pen6' |'def'   ['pen3'F'def']ilelist archives  'pen6'|'def
    SAY pen6' |'def'   ['pen3'S'def']earch files       'pen6'|'def
    SAY pen6' |'def'   ['pen3'U'def']pload             'pen6'|'def
    SAY pen6' |'def'   ['pen3'D'def']ownload           'pen6'|'def
    SAY pen6' |'def'   ['pen3'+'def'] Extra Devices    'pen6'|'def
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def'   ['pen3'K'def']ill a user        'pen6'|'def
    SAY pen6' |'def'   ['pen3'%'def'] edit filenote    'pen6'|'def
    SAY pen6' |'def'   ['pen3'('def'] file report      'pen6'|'def
    SAY pen6' |'def'   ['pen3';'def'] change username  'pen6'|'def;END
IF(level=99) THEN
    SAY pen6' |'def'   ['pen3'@'def'] dos shell        'pen6'|'def
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def
    SAY pen6' |'def'   ['pen3'.'def'] main menu        'pen6'|'def
    SAY pen6' |________________________|'def
  END
ELSE IF menu='MAIN' THEN
  DO
    SAY pen6'       _____________'def
    SAY pen6'  ____/  'pen3'Main Menu'pen6'  \_____'def
    SAY pen6' |                        |'def
    SAY pen6' |'def'   ['pen3'H'def']elp               'pen6'|'def
    SAY pen6' |'def'   ['pen3'I'def']nfomation         'pen6'|'def
    SAY pen6' |'def'   ['pen3'J'def']ump to doorways   'pen6'|'def
    SAY pen6' |'def'   ['pen3'Y'def']our user data     'pen6'|'def
    SAY pen6' |'def'   ['pen3'W'def']ho is here list   'pen6'|'def
    SAY pen6' |'def'   ['pen3'S'def']earch userlist    'pen6'|'def
    SAY pen6' |'def'   ['pen3'O'def']ther users info   'pen6'|'def
    SAY pen6' |'def'   ['pen3'V'def']iew user log      'pen6'|'def
    SAY pen6' |'def'   ['pen3'X'def']pert (no menus)   'pen6'|'def
    SAY pen6' |'def'   ['pen3'#'def'] toggle colors    'pen6'|'def
    SAY pen6' |'def'   ['pen3'$'def'] toggle menu(s)   'pen6'|'def
    SAY pen6' |'def'   ['pen3'&'def'] user profiles    'pen6'|'def
    SAY pen6' |'def'   ['pen3'Z'def'] bbs statistics   'pen6'|'def
    SAY pen6' |'def'   ['pen3','def'] hourly stats     'pen6'|'def
    SAY pen6' |'def'   ['pen3'G'def']oodbye (hangup)   'pen6'|'def
    SAY pen6' |'def'   ['pen3'F'def']iles menu         'pen6'|'def
    SAY pen6' |'def'   ['pen3'M'def']essages menu      'pen6'|'def
    SAY pen6' |________________________|'def
  END
ELSE IF menu='ALL' THEN
  DO
    SAY pen6'     __________________________________________________________'def
    SAY pen6'  __/   'pen3'Main Menu            File Menu          Message Menu 'pen6'  \__'def
    SAY pen6' |                                                                |'def
    SAY pen6' |'def' ['pen3'H'def']elp               ['pen3'A'def']lphabetical list  ['pen3'P'def']ost messages      'pen6'|'def
    SAY pen6' |'def' ['pen3'I'def']nformation        ['pen3'B'def']rowse filenotes   ['pen3'R'def']ead messages      'pen6'|'def
    SAY pen6' |'def' ['pen3'Z'def'] bbs statiZtics   ['pen3'L'def']ist by Library    ['pen3'E'def']mail (private)    'pen6'|'def
    SAY pen6' |'def' ['pen3'Y'def']our user data     ['pen3'N'def']ew files          ['pen3'C'def']omment to SYSOP   'pen6'|'def
    SAY pen6' |'def' ['pen3'O'def']ther users info   ['pen3'F'def']ilelist archiver  ['pen3'!'def'] YELL for SYSOP   'pen6'|'def
    SAY pen6' |'def' ['pen3'J'def']ump to doorways   ['pen3'+'def'] Extra Devices    ['pen3'X'def']pert (no menus)   'pen6'|'def
    SAY pen6' |'def' ['pen3'S'def']earch menu        ['pen3'D'def']ownload           ['pen3'$'def'] toggle menu(s)   'pen6'|'def
    SAY pen6' |'def' ['pen3'&'def'] user profiles    ['pen3'U'def']pload             ['pen3'#'def'] toggle colors    'pen6'|'def
    SAY pen6' |'def' ['pen3'V'def']iew user log      ['pen3'T'def']ransfer protocol  ['pen3','def'] hourly stats     'pen6'|'def
    SAY pen6' |'def' ['pen3'G'def']oodbye (logoff)   ['pen3'QUICK'def'] options      ['pen3'FL'def'] Friends List    'pen6'|'def
IF(level>sysoplevel) THEN DO
    SAY pen6' |'def' ['pen3'K'def']ill a user        ['pen3'%'def'] edit filenote    ['pen3'='def'] level report     'pen6'|'def
    SAY pen6' |'def' ['pen3'^'def'] view BBS logs    ['pen3'('def'] file report      ['pen3';'def'] change username  'pen6'|'def;END
IF(level=99) THEN
    SAY pen6' |'def' ['pen3'~'def'] online editor    ['pen3'@'def'] dos shell        ['pen3')'def'] email report     'pen6'|'def
    SAY pen6' |________________________________________________________________|'def
  END
SAY
RETURN


help:
ARG helppath .
SAY
SAY 'For more detailed help, use ['pen3'I'def']nformation commmand to read BBBBS.COMMANDS.'
IF helppath='MAIN' THEN
  SAY 'Commands available from the' pen3||menu||def 'menu:'
frontend=bbspath'BBS_HELP/'helppath
backend='.USER'
IF level=0 THEN backend='.NEW'
ELSE IF level=99 THEN backend='.SUPER'
ELSE IF level>sysoplevel THEN backend='.SYSOP'
CALL showtext(frontend||backend)
RETURN


waiting:
IF waitchar='Q' THEN
  DO
    waitchar=''
    RETURN
  END
waitchar=''
IF nonstop=1 THEN RETURN
OPTIONS PROMPT pen3'                       RETURN=Continue  'def
PULL waitchar
CALL cleanline(1)
RETURN


waiting2:
IF nonstop=1 THEN RETURN 0
waitchar=getinput(1 1 pen3'   Q=Quit   N=Non-Stop   RETURN=Continue  'def)
IF waitchar='N' THEN
  DO
    nonstop=1
    SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E        'def
    SAY
    CALL DELAY(100)
    waitchar=''
  END
CALL cleanline(1)
IF waitchar='Q' THEN RETURN 1
RETURN 0


busywait:
ARG bii bi bt
IF bbsprefs.21=0 THEN RETURN
IF bi<1 THEN
  DO
    CALL WRITECH(STDOUT,'080808'x)
    RETURN
  END
IF bi=1 THEN CALL WRITECH(STDOUT,'   ')
IF bi//(bii%2)~=0 THEN RETURN
b=bi//bii
IF b=0 | b=bii%2 THEN
  DO
    tp=RIGHT((bi*100)%bt,2)'%'
    CALL WRITECH(STDOUT,'080808'x||tp)
  END
RETURN


cleanline:
ARG lflag .
IF colorflag~=1 & lflag=1 THEN RETURN
cline=lineup||LEFT(' ',77)
IF lflag=1 THEN cline=cline||lineup
SAY cline
RETURN


getinput:
PARSE ARG upflag' 'oneflag' 'pline
OPTIONS PROMPT pline
PARSE PULL inarg
inarg=STRIP(inarg)
IF upflag THEN inarg=UPPER(inarg)
IF oneflag THEN inarg=LEFT(inarg,1)
RETURN inarg


docity:
PARSE ARG citi
citi=TRANSLATE(citi,'          ','+-.,*/()<>')
DO i=WORDS(citi) TO 1 BY -1
  IF DATATYPE(WORD(citi,i),'N') THEN citi=STRIP(DELWORD(citi,i,1))
  IF UPPER(WORD(citi,i))='USA' THEN citi=STRIP(DELWORD(citi,i,1))
END
citi=SPACE(citi,1)
RETURN STRIP(citi)


setdir:
PARSE ARG tempdir
CALL PRAGMA('D',STRIP(tempdir))
directory=PRAGMA('D')
slash=LASTPOS('/',directory)
IF slash=0 THEN slash=LASTPOS(':',directory)
plaindir=directory
IF slash>0 THEN plaindir=SUBSTR(plaindir,slash+1)
RETURN


config:
arg='s:CONFIG.BBS'
IF ~EXISTS(arg) THEN arg='BBS:BBS_TEXT/CONFIG.BBS'
IF readlines(arg 1) THEN
  DO
    SAY 's:CONFIG.BBS and BBS:BBS_TEXT/CONFIG.BBS are both missing!'
    SIGNAL DONE2
  END
compos=POS('/*',lynes.1)
IF compos>0 THEN lynes.1=LEFT(lynes.1,compos-1)
bbsname=STRIP(lynes.1)
sysop=WORD(lynes.2,1)
compos=POS('/*',lynes.3)
IF compos>0 THEN lynes.3=LEFT(lynes.3,compos-1)
exclusion=STRIP(lynes.3)
bbsdevice=WORD(lynes.4,1)
sysoplevel=WORD(lynes.5,1)
bbspath=WORD(lynes.6,1)
IF ~EXISTS(bbspath) THEN
  DO
    SAY bbspath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(bbspath,1)
IF testchar~='/' & testchar~=':' THEN bbspath=bbspath'/'
CALL SETCLIP('BBS_path',bbspath)
msgpath=WORD(lynes.7,1)
IF ~EXISTS(msgpath) THEN
  DO
    SAY msgpath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(msgpath,1)
IF testchar~='/' & testchar~=':' THEN msgpath=msgpath'/'
CALL SETCLIP('BBS_msgpath',msgpath)
msgpath=msgpath'MSG'
libpath=WORD(lynes.8,1)
IF ~EXISTS(libpath) THEN
  DO
    SAY libpath 'does not exist!'
    SIGNAL DONE2
  END
testchar=RIGHT(libpath,1)
IF testchar~='/' & testchar~=':' THEN libpath=libpath'/'
CALL SETCLIP('BBS_libpath',libpath)
extdevs=''
DO i=1 TO WORDS(lynes.10)
  test=WORD(lynes.10,i)
  IF POS(':',test)=0 THEN ITERATE i
  IF LEFT(test,2)='/*' THEN LEAVE i
  extdevs=STRIP(extdevs test)
END
SYSTEM_MSG_LIMIT=WORD(lynes.11,1)
SYSTEM_SPACE_LIMIT=WORD(lynes.12,1)
maxidle=WORD(lynes.13,1)
maxtime=WORD(lynes.14,1)
maxbps=WORD(lynes.15,1)
IF ~DATATYPE(maxbps,'W') THEN maxbps=2400
CALL SETCLIP('BBS_baud',maxbps)
DO i=16 TO 40
  j=i-15
  bbsprefs.j=STRIP(WORD(lynes.i,1))
END
spellpath=WORD(lynes.9,1)
IF bbsprefs.5 & ~EXISTS(spellpath) THEN
  DO
    SAY spellpath 'does not exist!'
    bbsprefs.5=0
  END
IF bbsprefs.10 THEN scratch=bbspath'Scratch'
ELSE scratch='RAM:Scratch'
CALL MAKEDIR(scratch)
IF ~DATATYPE(bbsprefs.16,'W') THEN bbsprefs.16=3
extension=WORD(lynes.32,1)
arccom=lynes.33
compos=POS('/*',lynes.33)
IF compos>0 THEN lynes.33=LEFT(lynes.33,compos-1)
arccom=STRIP(lynes.33)
IF LEFT(extension,1)~='.' THEN
  DO
    extension='.lzh'
    arccom='lharc -m m'
  END
RETURN


readlogs:
IF arg='' THEN
  arg=getinput(1 0 '['pen3'RETURN'def']=TODAY, or enter Log Date ('pen3||DATE('S')||def') > ')
IF arg='' THEN arg=DATE('S')
arg=bbspath'Logs/log.'arg
CALL readlines(arg 1)
CALL seelines(0)
nonstop=0
CALL waiting()
RETURN


loadcourtesy:
IF courtesyflag=0 & courtesy='' & EXISTS(bbspath'Lists/Courtesy') THEN
  DO
    IF readopen(bbspath'Lists/Courtesy') THEN
      DO
        SAY 'Checking Courtesy List...'
        DO i=1
          line=READLN(f)
          IF EOF(f) THEN BREAK
          courtesy=courtesy UPPER(line)
        END
        CALL CLOSE(f)
        MSG ''
        MSG pen3'Courtesy List:'def
        MSG courtesy
      END
  END
RETURN


fileheader:
SAY 'Filename          Bytes File# Library         KeyWords'
SAY pen3||LEFT('=',77,'=')||def
RETURN


showalpha:
IF DATATYPE(arg,'W') THEN
  DO
    dirnum=arg
    arg=''
    IF chdir2()>0 THEN RETURN
    test='Y'
  END
ELSE
  DO
    test=getinput(1 1 'Show one library only? (Ny) > ')
    IF test='Y' THEN
      IF chdir()>0 THEN RETURN
  END

showalpha2:
IF test='Y' THEN filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
ELSE filecount=files.0
SAY '  'filecount 'files.'
CALL fileheader()
count=0
DO wi=1 TO alpha.0
  CALL busywait(60 wi alpha.0)
  IF test='Y' THEN
    DO
      IF count>=filecount THEN LEAVE wi
      IF UPPER(LEFT(plaindir,12))~=UPPER(LEFT(WORD(alpha.wi,5),12)) THEN
        ITERATE wi
    END
  jj=WORD(alpha.wi,4)
  IF jj>level | FIND(data.21,UPPER(dirs.jj))>0 THEN
    ITERATE wi
  CALL busywait(4 0)
  SAY LEFT(alpha.wi,76)
  count=count+1
  IF (count+2)//linesperpage=0 THEN
    IF waiting2() THEN LEAVE wi
  CALL busywait(4 1)
END
CALL busywait(4 0)
nonstop=0
IF waitchar~='Q' THEN CALL waiting()
RETURN


profiles:
prodir=bbspath'Profiles'
CALL MAKEDIR(prodir)
pros=SHOWDIR(prodir)
protxt=bbspath'BBS_TEXT/PROFILES'
IF EXISTS(protxt) THEN CALL showtext(protxt)
DO lupe=1
  SAY
  SAY '       1. Edit 'name'''s user Profile'
  SAY '       2. View a User Profile'
  SAY '       3. Search User Profiles'
  SAY '       4. Browse User Profiles'
  SAY
  temp=getinput(1 1 'Enter Selection Number > ')
  IF temp=1 THEN
    DO
      lynes.=''
      IF EXISTS(prodir'/'name) THEN
        DO
          IF readlines(prodir'/'name 1)~=0 THEN ITERATE lupe
          CALL DELETE(prodir'/'name)
        END
      ELSE lynes.0=3
      lynes.1=name
      lynes.2='Profile Last Updated:' DATE('W') DATE() TIME('C')
      lynes.3=LEFT('=',74,'=')
      IF savelines(prodir'/'name)~=0 THEN
        DO
          line='Profile for' name 'failed to save!'
          SAY line
          CALL send2log(line)
          ITERATE lupe
        END
      edtype=''
      CALL bbsEd(4 prodir'/'name)
      IF readlines(prodir'/'name 1)~=0 THEN CALL DELETE(prodir'/'name)
      IF lynes.0<4 THEN CALL DELETE(prodir'/'name)
      pros=SHOWDIR(prodir)
    END
  ELSE IF temp=2 THEN
    DO pf=1
      totpros=WORDS(pros)
      DO pfl=1 TO totpros BY 3
        pfl2=pfl+1
        pfl3=pfl+2
        pfline=pen3||RIGHT(pfl,3)||def LEFT(WORD(pros,pfl),21)
        IF pfl2<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(WORD(pros,pfl2),21)
        IF pfl3<=totpros THEN
          pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(WORD(pros,pfl3),21)
        SAY pfline
        IF nonstop~=1 & ((pfl3%3)//linesperpage)=0 THEN
          IF waiting(2) THEN LEAVE pfl
      END
      emnum=getinput(1 0 pen3'Select User Profile Number > 'def)
      IF DATATYPE(emnum,'W') & emnum>0 & emnum<=totpros THEN
        DO
          tmp=WORD(pros,emnum)
          IF level>sysoplevel THEN
            DO
              CALL bbsEd(1 prodir'/'tmp)
              IF readlines(prodir'/'tmp 1)~=0 THEN CALL DELETE(prodir'/'tmp)
              IF lynes.0<4 THEN CALL DELETE(prodir'/'tmp)
              pros=SHOWDIR(prodir)
            END
          ELSE CALL showtext(prodir'/'tmp)
        END
      ELSE LEAVE pf
    END
  ELSE IF temp=3 | temp=4 THEN
    DO
      searcharg=''
      nonstop=0
      IF temp=3 THEN
        DO
          searcharg=STRIP(getinput(0 0 'Enter Search Phrase > '))
          IF searcharg='' THEN ITERATE lupe
        END
      DO ui=1 TO WORDS(pros)
        pro=prodir'/'WORD(pros,ui)
        IF temp=3 THEN
          IF textsearch(pro searcharg)=0 THEN ITERATE ui
        SAY
        CALL readlines(pro 1)
        IF nonstop=1 THEN rnonstop=1
        ELSE rnonstop=0
        CALL seelines(2)
        IF rnonstop THEN nonstop=1
        ELSE IF waiting2()=1 THEN LEAVE ui
        SAY
        SAY
      END
    END
  ELSE IF temp='' | LEFT(temp,1)='Q' THEN LEAVE lupe
END
DROP pros
RETURN


otheruser:
line=''
IF level>sysoplevel THEN line='['pen3'R'def']eport or'
line=line '['pen3'D'def']etails or simple ['pen3'N'def']amelist?'
IF level>sysoplevel THEN line=line '(Dnr) > '
ELSE line=line '(Dn) > '
temp=getinput(1 1 line)
IF temp='N' THEN
  DO
    CALL showuserlist()
    RETURN
  END
ELSE IF level>sysoplevel & temp='R' THEN
  DO
    SAY
    line=''
    IF getinput(1 1 'Report on inactive users? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        SAY 'INACTIVE_USERS report will be in your email.'
        line='USERS '
      END
    IF getinput(1 1 'Report on actual files vs. filelists? (nY) > ')~='N' THEN
      DO
        CALL cleanline(0)
        line=line'FILES'
        line=STRIP(line getinput(1 0 'Report only files larger than (0) bytes > '))
        SAY 'FILELISTS_REPORT will be in your email.'
      END
    SAY
    ADDRESS AREXX bbsREPORT.rexx name line
    RETURN
  END
SAY
SAY 'To allow (or not) other users to see your street address and/or phone number,'
SAY 'add (or delete) STREET and/or PHONE to the line 8 list in ['pen3'Y'def']our userfile.'
SAY
SAY 'User specification may include ? wildcard for single characters.'
SAY 'ie,' pen3's?n'def 'will return all user names containing ''son'', ''sen'', ''sin'', etc.'
IF arg='' THEN arg=getinput(1 0 pen3'User specification: 'def)
IF arg='' THEN RETURN
arg=TRANSLATE(STRIP(arg),'_',' ')
CALL FileList(bbspath'Users/*'arg'*',wildlist)
line='Found' wildlist.0 'match'
IF wildlist.0~=1 THEN line=line'es'
SAY line'.'
IF wildlist.0<1 THEN RETURN
totlines=0
nextpagebreak=linesperpage-3
extrainfo=0
IF level>sysoplevel THEN
  DO
    IF getinput(1 1 'Display -sysop only- information? (nY) > ')~='N' THEN
      extrainfo=1
  END
DO i=1 TO wildlist.0
  CALL readlines(wildlist.i 1)
  SAY
  totlines=totlines+6
  SAY bak2' 'SUBSTR(wildlist.i,LASTPOS('/',wildlist.i)+1)' 'def
  SAY lynes.1
  IF FIND(UPPER(lynes.8),'STREET')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.2
    END
  SAY lynes.3
  IF FIND(UPPER(lynes.8),'PHONE')>0 THEN
    DO
      totlines=totlines+1
      SAY lynes.4
    END
  SAY 'Last time on' bbsname':' DATE(,WORD(lynes.13,1),'S') WORD(lynes.13,2)
  SAY pen3'Interests:'def lynes.10
  IF extrainfo THEN
    DO
      SAY pen3'   up:'def lynes.14
      SAY pen3' down:'def lynes.15
      temptot=0
      DO j=1 TO WORDS(lynes.23)
        IF DATATYPE(WORD(lynes.23,j),'W') THEN temptot=temptot+WORD(lynes.23,j)
      END
      SAY pen3' writ:'def temptot 'public messages.'
      SAY pen3'level:'def lynes.20
      totlines=totlines+4
      IF lynes.21~='' THEN
        DO
          totlines=totlines+1
          SAY pen3'excluded dirs:'def lynes.21
        END
    END
  IF nonstop~=1 & totlines>=nextpagebreak THEN
    DO
      IF waiting2() THEN LEAVE i
      nextpagebreak=totlines+linesperpage-5
    END
END
nonstop=0
DROP wildlist.
IF waitchar~='Q' THEN CALL waiting()
RETURN


changename:
ARG cname
IF level<=sysoplevel THEN RETURN
IF cname='' THEN cname=getinput(1 0 'Current Username (include underscore): ')
IF readlines(bbspath'Users/'cname 1)>0 THEN RETURN
IF WORD(lynes,20)>=level THEN RETURN
CALL SETCLIP('BBS_oldname',cname)
CALL ChangeUserName.rexx()
cname=GETCLIP('BBS_newname')
CALL DELETE(bbspath'Lists/USERS')
sortuserflag=1
CALL SETCLIP('BBS_oldname')
CALL SETCLIP('BBS_newname')
RETURN cname


levelreport:
minlev=0
maxlev=99
templist=''
uname=''
newufile=bbspath'Lists/NEW_USERS'
IF EXISTS(newufile) THEN
  DO
    IF getinput(1 1 'Latest New Users Only? (nY) > ')~='N' THEN
      DO
        IF readlines(newufile 1)=0 THEN
          DO i=2 TO lynes.0
            templist=STRIP(templist WORD(lynes.i,3))
          END
      END
    ELSE newufile=''
  END
ELSE newufile=''
IF newufile='' THEN
  DO
    minlev=getinput(1 0 'Minimum level? (0) > ')
    maxlev=getinput(1 0 'Maximum level? (99) > ')
    IF ~DATATYPE(minlev,'W') THEN minlev=0
    IF ~DATATYPE(maxlev,'W') THEN maxlev=99
    IF minlev<0 | minlev>99 THEN minlev=0
    IF maxlev<0 | maxlev>99 THEN maxlev=99
    templist=userlist
  END
DO levi=1 TO WORDS(templist)
  arg=bbspath'Users/'WORD(templist,levi)
  CALL readlines(arg 1)
  lt=WORD(lynes.20,1)
  IF ~DATATYPE(lt,'W') THEN lt=0
  IF lt<minlev | lt>maxlev THEN ITERATE levi
  line=lt WORD(templist,levi)
  SAY line
  IF newufile~='' | lt<10 THEN
    DO
      SAY line
      DO levj=1 TO 12
        SAY pen3'  'lynes.levj||def
      END
      SAY pen3'  'lynes.19||def
    END
  ELSE ITERATE levi
  lcom=''
  IF lt<10 THEN lcom='['pen3'A'def']dd or '
  lcom=lcom'['pen3'K'def']ill or ['pen3'R'def']ename or ['pen3'S'def']kip this user?'
  IF lt<10 THEN lcom=lcom' (Akrs) > '
  ELSE lcom=lcom '(krS) > '
  lcom=getinput(1 1 lcom)
  CALL cleanline(0)
  IF lcom='K' THEN
    DO
      arg=WORD(templist,levi)
      CALL killuser()
    END
  ELSE IF lcom='R' THEN
    DO
      newname=changename(WORD(templist,levi))
      IF newname~='' & newname~=WORD(templist,levi) THEN
        DO
          temp=WORDINDEX(templist,levi+1)
          rtemp=''
          IF temp>0 THEN rtemp=SUBSTR(templist,temp)
          temp=WORDINDEX(templist,levi)
          templist=''
          IF temp>2 THEN templist=STRIP(LEFT(templist,temp-1))
          templist=STRIP(templist newname rtemp)
          userlist=userlist newname
        END
      levi=levi-1
      CALL SETCLIP('BBS_newname')
    END
  ELSE IF lcom~='S' & lt<10 THEN
    DO
      IF readopen(bbspath'BBS_TEXT/DEF.MEMBER') THEN
        DO
          DO lvi=1 TO 22
            line=READLN(f)
            IF lvi=11 THEN lynes.11=line
            IF lvi=20 THEN lynes.20=line
            IF lvi=21 THEN lynes.21=line
          END
          lynes.22=line
          CALL CLOSE(f)
          edtype=''
          IF bbsprefs.25=1 THEN
            DO
              SAY
              IF DATATYPE(lynes.20,'W') THEN
                DO
                  lynes.22=''
                  lynes.23=''
                  SAY 'Setting message counters to last 10 messages in each conference...'
                  DO i=1 TO lynes.20
                    num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
                    IF num<0 | msg.i.0<10 THEN num=0
                    lynes.22=lynes.22 num
                    lynes.23=lynes.23 0
                  END
                END
              ELSE SAY 'Bad default level in BBS_TEXT/DEF.MEMBER file!'
              SAY 'Setting file counter to last file uploaded...'
              lynes.16=countcheck(bbspath'Numbers/LastFile' 0)
              lynes.16=lynes.16 '19900101 00:00:00'
            END
          lynes.0=27
          CALL savelines(arg)
          SAY lynes.20 WORD(templist,levi) 'has been made a member.'
        END
      ELSE SAY 'You need a default member file in BBS_TEXT!  ( BBS_TEXT/DEF.MEMBER )'
    END
  IF lcom~='K' & lcom~='R' & newufile~='' THEN
    DO
      nlt=getinput(1 0 lynes.20 'Enter new level or blank for no change. > ')
      IF DATATYPE(nlt,'W') THEN
        DO
          lynes.20=nlt
          CALL savelines(arg)
        END
      CALL writenew()
    END
END
IF newufile~='' & EXISTS(newufile) THEN
  IF getinput(1 1 'Delete NEW_USERS file? (nY) > ')~='N' THEN CALL DELETE(newufile)
IF EXISTS(bbspath'Lists/CBV_USERS') THEN
  IF getinput(1 1 'Delete CBV_USERS file? (nY) > ')~='N' THEN
    CALL DELETE(bbspath'Lists/CBV_USERS')
DROP templist
RETURN


writenew:
arg=WORD(templist,levi)
IF getinput(1 1 'Write' arg 'an email message? (nY) > ')~='N' THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/EMAIL_WELCOME') THEN
      IF getinput(1 1 'Use default welcome? (nY) > ')~='N' THEN replysubj='|@NEW@|'
    CALL editor('MAIL' arg)
  END
RETURN


filereport:
SAY 'Searching for mismatches between files and filenotes...'
DO i=1 TO sysoplevel+1
  IF dirs.i='' THEN ITERATE
  SAY dirs.i'                               'lineup
  rfiles=SHOWDIR(libpath||dirs.i)
  rnotes=SHOWDIR(bbspath'FileNotes/'dirs.i)
  IF WORDS(rfiles)~=WORDS(rnotes) THEN
    DO
      line='Compare files & filenotes in'pen3 dirs.i||def'. '
      DO j=1 TO WORDS(rfiles)
        IF FIND(UPPER(rnotes),UPPER(WORD(rfiles,j)))=0 THEN
          line=line WORD(rfiles,j)
      END
      SAY line
    END
END
SAY '07'x
CALL waiting()
RETURN


mailreport:
SAY 'Checking ALL pending Email...'
SAY pen3' - Use CTRL-E to Exit -'def
SAY
mailrep=SHOWDIR(bbspath'Email','D')
mailfil=SHOWDIR(bbspath'EmailFiles','D')
lastemail=WORD(data.17,3)
IF ~DATATYPE(lastemail,'W') THEN lastemail=0
IF lastemail=countcheck(bbspath'Numbers/LastMail' 0) THEN
  DO
    DROP mailrep. mailfil.
    RETURN
  END
mailynes.=''
mk=0
DO mi=1 TO WORDS(mailrep)
  muser=WORD(mailrep,mi)
  IF muser=sysop | muser=name THEN ITERATE mi
  mlist=SHOWDIR(bbspath'Email/'muser)
  IF WORDS(mlist)>0 THEN SAY lineup||RIGHT(muser,40)
  DO mj=1 TO WORDS(mlist)
    fuser=WORD(mlist,mj)
    IF POS(sysop,fuser)>0 THEN ITERATE mj
    IF logonflag=0 THEN
      DO
        mk=mk+1
        mailynes.mk=pen3||LEFT(muser,20) 'from'def LEFT(fuser,20) DATE(,WORD(STATEF(bbspath'Email/'muser'/'fuser),5),'I')
      END
    IF POS(sysop,fuser)=0 & POS(name,fuser)=0 THEN
      DO
        testnum=RIGHT(fuser,LENGTH(fuser)-LASTPOS('.',fuser))
        IF testnum>emailnum THEN emailnum=testnum
        IF testnum>lastemail THEN
          DO
            CALL showtext(bbspath'Email/'muser'/'fuser)
            SAY
            SAY
            IF waitchar='Q' THEN LEAVE mi
          END
      END
  END
  IF logonflag=0 & FIND(mailfil,muser)>0 THEN
    DO
      efilelist=SHOWDIR(bbspath'EmailFiles/'muser)
      IF WORDS(efilelist)>0 THEN
        DO
          mk=mk+1
          mailynes.mk=pen3||LEFT(muser,20) 'emailfiles'def efilelist
        END
    END
END
data.17=WORD(data.17,1) WORD(data.17,2) countcheck(bbspath'Numbers/LastMail' 0)
IF mk>0 THEN
  DO
    lynes.0=mk
    DO mi=1 TO mk
      lynes.mi=mailynes.mi
    END
    CALL seelines(1)
    nonstop=0
    CALL waiting()
  END
ELSE SAY 'No unseen Email pending.'
DROP mailrep. mailfil. mailynes. mlist
RETURN


sortdoors:
IF ~DATATYPE(jdoors.0,'W') THEN doors.0=0
IF WORDS(SHOWDIR(bbspath'rexxDoors','F'))~=doors.0 THEN
  DO
    jdoors.=''
    doorlist=SHOWDIR(bbspath'rexxDoors','F')
    doors.=''
    doors.0=WORDS(doorlist)
    DO i=1 TO doors.0
      doors.i=WORD(doorlist,i)
    END
    SAY 'Sorting..'lineup
    CALL QSORT(1,doors.0,doors)
    jdoors.0=doors.0%3
    IF (doors.0//3)>0 THEN jdoors.0=jdoors.0+1
    DO i=1 TO jdoors.0
      DO j=0 TO 2
        k=i+j*jdoors.0
        IF k<=doors.0 THEN
          DO
            jdoors.i=jdoors.i' 'LEFT(RIGHT(k,3)'.' LEFT(doors.k,LENGTH(doors.k)-5),24)
            dcount=WORD(STATEF(bbspath'rexxDoors/'doors.k),8)
            jdoors.i.0=jdoors.i.0||LEFT(RIGHT(dcount,5) LEFT(doors.k,LENGTH(doors.k)-5),24)' '
          END
      END
    END
  END
RETURN 0


jump2rexx:
CALL sortdoors()
temp=1
readcount=-1
DO doorloop=1
  IF temp=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          doors.0=''
          CALL sortdoors()
        END
      SAY CENTER('- Number of accesses per file -',75)
    END
  SAY pen3||LEFT('-',75,'-')||def
  DO jd=1 TO jdoors.0
    IF temp=0 THEN SAY jdoors.jd.0
    ELSE SAY jdoors.jd
    IF jd//linesperpage=0 THEN CALL waiting()
    IF waitchar='Q' THEN LEAVE doorloop
  END
  IF temp=0 THEN
    DO
      CALL waiting()
      temp=1
      ITERATE doorloop
    END
  temp=getinput(1 0 pen3'Select Application Number. 0=Stats > 'def)
  IF temp=0 THEN ITERATE doorloop
  IF ~DATATYPE(temp,'W') | temp<1 | temp>doors.0 THEN LEAVE doorloop
  arg=doors.temp
  IF GETCLIP('BBS_door')=arg THEN
    DO
      SAY 'That door is in use!'
      ITERATE doorloop
    END
  CALL SETCLIP('BBS_localdoor',arg)
  readcount=WORD(STATEF(bbspath'rexxDoors/'arg),8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  ADDRESS COMMAND 'C:filenote' bbspath'rexxDoors/'arg readcount+1
  curdir=PRAGMA('D')
  CALL setdir(bbspath'rexxDoors')
  bbspath'rexxDoors/'doors.temp name winnings 0 colorflag 6000
  CALL setdir(curdir)
  CALL SETCLIP('BBS_localdoor')
END
CALL SETCLIP('BBS_localdoor')
RETURN


sortlibraries:
SAY 'Sorting Libraries...'
count=0
sdirs.=''
DO i=1 TO level
  IF dirs.i='' THEN ITERATE i
  count=count+1
  sdirs.count=dirs.i i
END
sdirs.0=count
CALL QSort(1,count,sdirs)
count=0
libs.=''
DO i=1 TO sdirs.0
  tempnum=WORD(sdirs.i,2)
  tempdir=WORD(sdirs.i,1)
  IF FIND(data.21,UPPER(tempdir))=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'. 'LEFT(tempdir,14)
      count=count+1
      libs.count=string
    END
END
libs.0=count%4
IF (count//4)>0 THEN libs.0=libs.0+1
DO i=1 TO libs.0
  DO j=1 TO 3
    k=i+j*libs.0
    IF k<=count THEN libs.i=libs.i||libs.k
  END
END
DROP sdirs.
CALL sortconferences()
RETURN


sortconferences:
SAY 'Sorting Conferences...'
count=0
smsg.=''
DO i=1 TO level
  IF msg.i='' THEN ITERATE i
  count=count+1
  smsg.count=msg.i i
END
smsg.0=count
CALL QSort(1,count,smsg)
count=0
msgs.=''
DO i=1 TO smsg.0
  tempnum=WORD(smsg.i,2)
  tempdir=WORD(smsg.i,1)
  IF FIND(data.21,tempnum)=0 THEN
    DO
      string=' '
      IF tempnum<10 THEN string=string' '
      string=string || tempnum'.'
      IF WORD(data.22,tempnum)='' | WORD(data.22,tempnum)>=0 THEN
        string=string LEFT(tempdir,20)
      ELSE string=string pen3'-OFF-'def LEFT(tempdir,14)
      count=count+1
      msgs.count=string
    END
END
msgs.0=count%3
IF (count//3)>0 THEN msgs.0=msgs.0+1
DO i=1 TO msgs.0
  DO j=1 TO 2
    k=i+j*msgs.0
    IF k<=count THEN msgs.i=msgs.i msgs.k
  END
END
DROP smsg.
RETURN


readmessages:
searcharg=''
DO FOREVER
  SAY
  PARSE VAR arg temp' 'arg .
  IF DATATYPE(temp,'W') THEN msgdir=temp
  ELSE IF LEFT(UPPER(temp),1)='A' THEN
    DO
      CALL newmsgs()
      arg=''
      RETURN
    END
  ELSE IF LEFT(UPPER(temp),1)='M' THEN
    DO
      CALL readmarked()
      arg=''
      RETURN
    END
  ELSE
    DO
      SAY 'Select Message Conference By Number, ['pen3'M'def']arked only or ['pen3'A'def']ll Active'
      IF areaselect() THEN
        DO
          IF LEFT(temp,1)='A' THEN CALL newmsgs()
          IF LEFT(temp,1)='M' THEN CALL readmarked()
          RETURN
        END
    END
  pline='['pen3'A'def']rchive ['pen3'S'def']earch ['pen3'T'def']oggle ON/OFF'
  pline=pline '['pen3'R'def']ead ['pen3'Q'def']uit (aqRst) > '
  IF arg~='' THEN junk=UPPER(LEFT(arg,1))
  ELSE junk=getinput(1 1 pline)
  IF junk='Q' THEN RETURN
  IF junk='A' THEN
    DO
      SAY
      CALL msgcount(msgdir)
      junk=getinput(1 0 pen3'RETURN'def' to archive new msgs, ['pen3'Q'def']uit, or enter starting message number > ')
      IF junk='Q' THEN RETURN
      IF DATATYPE(junk,'W') THEN
        DO
          IF junk>lastmess | junk<1 THEN junk=1
          lastread.msgdir=junk-1
          CALL savedata(1)
        END
      CALL SETCLIP('BBS_MSGS','ON')
      SAY 'Archiving messages in the'pen3 msg.msgdir def'Conference...'
      lastread.msgdir=lastmess
      ADDRESS AREXX ArcMsgs.rexx name msgdir
      IF emailonline>=0 THEN emailonline=emailonline+1
      DO WHILE GETCLIP('BBS_MSGS')~=''
        CALL DELAY(14)
      END
      SAY 'When completed, the archive will be attached to email addressed to you.'
      CALL savedata(1)
      SAY
      RETURN
    END
  IF junk='S' THEN
    DO
      searcharg=''
      searcharg=getinput(0 0 pen3'Search Phrase: 'def)
      IF LENGTH(STRIP(searcharg))=0 THEN RETURN
      searcharg=COMPRESS(searcharg,'*')
      SAY
      CALL searchmsgdir()
      SAY
      SAY 'All messages in the'pen3 msg.msgdir def'Conference have been searched.'
      SAY
      CALL waiting()
      searcharg=''
      RETURN
    END
  IF junk='T' THEN
    DO
      line='Turning the' msg.msgdir 'conference'
      IF WORD(data.22,msgdir)<0 THEN
        DO
          line=line pen3'ON'def'.'
          newdata='0'
        END
      ELSE
        DO
          line=line pen3'OFF'def'.'
          newdata='-1'
        END
      SAY line
      dataloc=WORDINDEX(data.22,msgdir)-1
      data.22=DELWORD(data.22,msgdir,1)
      IF dataloc>0 THEN data.22=INSERT(newdata' ',data.22,dataloc)
      CALL sortconferences()
    END
  CALL readmsg(0)
  CALL saveData(1)
  nonstop=0
  arg=''
END
RETURN


newmsgs:
test=UPPER(LEFT(arg,1))
IF test='' THEN
  test=getinput(1 1 '['pen3'R'def']ead new messages or ['pen3'A'def']rchive for later download. (aR) > ')
IF test='A' THEN
  DO
    CALL SETCLIP('BBS_MSGS','ON')
    SAY
    SAY 'Archiving new conference messages...'
    ADDRESS AREXX ArcMsgs.rexx name
    IF emailonline>=0 THEN emailonline=emailonline+1
    clear_marked=1
    DO i=1 TO level
      IF WORD(data.22,i)~=-1 THEN
        lastread.i=countcheck(bbspath'Numbers/LastMessage'i 0)
    END
    DO WHILE GETCLIP('BBS_MSGS')~=''
      CALL DELAY(14)
    END
    SAY 'When completed, the archive will be attached to email addressed to you.'
    CALL savedata(1)
    SAY
    RETURN
  END
curmsgdir=msgdir
SAY 'Scanning all Conferences for new messages..'
DO newi=1 TO level
  IF msg.newi='' THEN ITERATE newi
  msgdir=newi
  CALL readmsg(1)
  IF msgcom='Q' THEN LEAVE newi
END
CALL saveData(1)
msgdir=curmsgdir
nonstop=0
RETURN


readmsg:
ARG quietflag marknum .
msgcom=''
IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN RETURN; /* sysop excluded */
IF WORD(data.22,msgdir)=-1 THEN RETURN;                /*  user excluded */
entering='Entering'pen3 msg.msgdir def'Message Conference..'
IF quietflag=0 & marknum='' THEN SAY entering
IF DATATYPE(WORD(data.22,msgdir),'W') THEN
  lastread.msgdir=WORD(data.22,msgdir)
ELSE lastread.msgdir=0
lstwrt=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
frstwrt=countcheck(bbspath'Numbers/FirstMessage'msgdir 0)
temp=''
IF marknum='' THEN
  DO
    IF lastread.msgdir>=lstwrt | lastread.msgdir<frstwrt THEN
      DO
        lastread.msgdir=lstwrt
        CALL msgcount(msgdir)
        IF quietflag=1 & lastread.msgdir=lstwrt THEN RETURN
        IF nonstop=1 THEN temp=''
        ELSE temp=getinput(1 0 pen3'Enter starting message number > 'def)
        IF temp='' THEN temp=lastread.msgdir
        IF ~DATATYPE(temp,'W') THEN RETURN
        IF temp<frstwrt THEN temp=frstwrt
        IF temp>lstwrt THEN temp=lstwrt
        IF temp<1 THEN temp=1
        lastread.msgdir=temp-1
      END
  END
ELSE lastread.msgdir=marknum-1
IF quietflag=1 THEN SAY entering
dirname=msgpath||msgdir
msglist.=0 /* set read to 0, unread to 1, and reply >=2 */
firstmess=999999
testlist=SHOWDIR(dirname)
DO i=1 TO WORDS(testlist)
  test=WORD(testlist,i)
  IF test>lastread.msgdir THEN msglist.test=1
  IF test<firstmess THEN firstmess=test
END
IF firstmess=999999 THEN firstmess=0
CALL countcheck(bbspath'Numbers/FirstMessage'msgdir firstmess)
msgstatus=1
IF temp='' & marknum='' THEN CALL msgcount(msgdir)
skipsubj.=''
skipsubj.0=0
DO msgloop=1
  lastreadnum=lastread.msgdir
  DO WHILE msglist.lastreadnum=0 & lastreadnum<lstwrt
    lastreadnum=lastreadnum+1
  END
  lastread.msgdir=lastreadnum
  IF lastreadnum=lstwrt & msglist.lstwrt=0 THEN LEAVE msgloop
  DO mess=lastread.msgdir TO lstwrt+1
    IF marknum~='' THEN
      DO
        IF mess>marknum THEN LEAVE msgloop
        mess=marknum
      END
    IF msglist.mess~=msgstatus THEN ITERATE mess
    IF msgstatus>1 THEN SAY 'Following the thread, level' msgstatus-1'.'
    msglist.mess=0
    arg=dirname'/'mess
    IF ~EXISTS(arg) THEN
      DO
        SAY 'Message number' mess 'is missing.'
        ITERATE mess
      END
    IF ~readopen(arg) THEN ITERATE mess
    firstline=READLN(f)
    secondline=READLN(f)
    thirdline=READLN(f)
    forthline=READLN(f)
    CALL CLOSE(f)
    CALL killmark(msgdir mess)
    DO skp=1 TO skipsubj.0
      IF forthline=skipsubj.skp THEN ITERATE mess
    END
    IF WORDS(firstline)>2 THEN /* if replies, change their num to >1 */
      DO
        thread=SUBSTR(firstline,WORDINDEX(firstline,4))
        DO tindx=1 TO WORDS(thread)
          test=WORD(thread,tindx)
          IF msglist.test~=0 THEN msglist.test=msgstatus+1
        END
      END
    savearg=arg
    msgcom='A'
    DO msgloop2=1 WHILE msgcom='A' | msgcom='O'
      CALL readlines(arg 1)
      IF nonstop=1 THEN rnonstop=1
      ELSE rnonstop=0
      CALL seelines(2)
      msgcom=''
      IF rnonstop THEN
        DO
          SAY
          nonstop=1
          msgcom=''
        END
      ELSE
        DO
          pline=''
          IF level<=sysoplevel | WORDS(lynes.3)<3 THEN pline='['pen3'A'def']gain'
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            pline=pline '['pen3'E'def']dit ['pen3'K'def']ill'
          IF level>sysoplevel THEN pline=pline '['pen3'M'def']ove'
          IF WORDS(lynes.3)>3 THEN pline=pline '['pen3'O'def']riginal'
          pline=pline '['pen3'N'def']onStop ['pen3'R'def']eply'
          IF level=99 THEN pline=pline '['pen3'!'def']'
          pline=pline '['pen3'S'def']kip ['pen3'Q'def']uit ['pen3'?'def']'
          msgcom=getinput(1 0 STRIP(pline)' > ')
          CALL cleanline(0)
        END
      IF DATATYPE(msgcom,'W') & EXISTS(dirname'/'msgcom) THEN
        DO
          arg=dirname'/'msgcom
          IF msgcom>lastread.msgdir THEN lastread.msgdir=msgcom
          msgcom='A'
          ITERATE msgloop2
        END
      ELSE msgcom=LEFT(msgcom,1)
      IF msgcom='Q' THEN LEAVE msgloop
      ELSE IF msgcom='!' & level>sysoplevel THEN
        DO
          CALL DELETE(arg)
          newchar=LEFT(lynes.1,1)
          IF newchar~='!' THEN newchar='!!'
          ELSE newchar='  '
          lynes.1=OVERLAY(newchar,lynes.1,1,2)
          CALL savelines(arg)
          ITERATE msgloop2
        END
      ELSE IF msgcom='A' THEN ITERATE msgloop2
      ELSE IF msgcom='M' & level>sysoplevel THEN
        DO
          prevmsgdir=msgdir
          If ~areaselect() THEN
            DO
              himsg=countcheck(bbspath'Numbers/LastMessage'msgdir 0)+1
              lynes.1='  Msg:' himsg
              lynes.3='   To:' WORD(lynes.3,2)
              lynes.5=STRIP(DELWORD(lynes.5,8,1)) msg.msgdir
              nlyn=lynes.0+1
              lynes.0=nlyn
              lynes.nlyn=' *** Moved from the' msg.prevmsgdir 'conference ***'
              CALL savelines(msgpath||msgdir'/'himsg)
              CALL countcheck(bbspath'Numbers/LastMessage'msgdir himsg)
              CALL msgmark(WORD(lynes.3,2) msgdir himsg)
              CALL readlines(arg 1)
              CALL DELETE(arg)
              CALL DELAY(28)
              lynes.0=7
              lynes.7='*** Moved to the' msg.msgdir 'conference, message #'himsg' ***'
              CALL savelines(arg)
            END
          msgdir=prevmsgdir
          msgcom='A'
        END
      ELSE IF msgcom='N' THEN
        DO
          nonstop=1
          msgcom=''
        END
      ELSE IF msgcom='H' | msgcom='?' THEN
        DO
          SAY pen3' - HELP with the Read Messages commands -'def
          SAY ' RETURN reads the next message in line.'
          SAY ' 34 will read message number 34, if it exists in this conference.'
          SAY ' A  reads this message Again (in case it scrolled off screen).'
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
          SAY ' E  puts this message into the online Editor.'
          SAY ' K  deletes a message you wrote. you cannot Kill others!'
            END
          IF level>sysoplevel THEN
          SAY ' M  move this message to a new conference.'
          SAY ' N  displays all new messages without pausing. CTRL-E to Exit!'
          SAY ' O  if this message is a reply, will read the Original message.'
          SAY ' R  enters the message editor to Reply to this message.'
          SAY ' S  allows you to Skip threads or conferences.'
        IF level=99 THEN
          SAY ' !  toggles the do-not-purge! flag for this message.'
          SAY ' Q  returns to the message menu. (Quit)'
          SAY
          CALL waiting()
          msgcom='A'
          IF waitchar='Q' THEN LEAVE msgloop
        END
      ELSE IF msgcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              sline=7
              IF level>sysoplevel THEN sline=1
              CALL bbsED(sline arg)
              msgcom='A'
            END
        END
      ELSE IF msgcom='S' & mess<lstwrt THEN
        DO
          stemp=''
          DO WHILE stemp~='T' & stemp~='C'
            stemp=getinput(1 1 'Skip this ['pen3'T'def']hread or the entire ['pen3'C'def']onference (ct) > ')
          END
          IF stemp='T' THEN
            DO
              SAY
              SAY pen3 forthline||def
              SAY 'Skipping messages with this subject heading...'
              SAY
              DO i=lastread.msgdir TO lstwrt
                IF msglist.i>1 THEN msglist.i=0
              END
              skipsubj.0=skipsubj.0+1
              sksb=skipsubj.0
              skipsubj.sksb=forthline
            END
          ELSE
            DO
              SAY pen3'Skipping to the last message in the'def msg.msgdir pen3'conference.'def
              lastread.msgdir=lstwrt-1
              lw=lstwrt-1
              msglist.lw=0
              msglist.lstwrt=1
              LEAVE mess
            END
        END
      ELSE IF msgcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.2,2) THEN
            DO
              IF getinput(1 1 'Really delete' arg'? (Ny) > ')='Y' THEN
                DO
                  IF DELETE(arg)=1 THEN
                    SAY pen3||arg||def' has been deleted.'
                  grand=grand-1
                  msg.msgdir.0=msg.msgdir.0-1
                END
            END
        END
      ELSE IF msgcom='O' THEN   /* go back and read original */
        DO
          IF WORDS(lynes.3)>3 THEN
            DO
              temp=WORD(lynes.3,4)
              arg=dirname'/'temp
            END
          ELSE SAY 'This is the original message.'
        END
      ELSE IF msgcom='R' THEN        /*  toname     msgnum  */
        DO
          msgnum=WORD(lynes.1,2)
          forthline=lynes.4
          IF editor('REPLY' WORD(lynes.2,2) msgnum) THEN /* reply */
            DO
              savearg2=arg
              arg=dirname'/'WORD(lynes.3,4)
              IF EXISTS(arg) THEN
                DO
                  IF readlines(arg 1) THEN BREAK
                  xmsg=countcheck(bbspath'Numbers/LastMessage'msgdir mess)
                  IF WORDS(lynes.1)>3 THEN lynes.1=lynes.1 xmsg
                  ELSE lynes.1=lynes.1'   Reply' xmsg
                  CALL DELAY(28)    /* allow 1/2 sec for read to close */
                  CALL savelines(arg)
                END
              arg=savearg2
            END
        END
      ELSE IF arg~=savearg THEN    /* Continue */
        DO
          msgcom='A'
          arg=savearg
        END
    END
    IF thread~='' THEN
      DO
        thread=''
        msgstatus=msgstatus+1
      END
  END
  IF msgstatus>1 THEN msgstatus=msgstatus-1
END
DROP msglist. skipsubj.
IF quietflag~=1 THEN nonstop=0
RETURN


showmarked:
ARG ff .
IF WORDS(data.24)<1 THEN RETURN
fline='These unread conference messages have been ['pen3'M'pen6']arked as addressed to you:'
IF ff THEN
  DO
    SAY
    SAY pen6||fline||def
  END
tempkk=data.24
DO i=1 TO WORDS(tempkk)
  tempk=WORD(tempkk,i)
  PARSE VAR tempk kdir'/'kmsg
  line=RIGHT(kmsg,6) 'in the'pen3 msg.kdir def'conference'
  IF EXISTS(msgpath||tempk) THEN
    DO
      IF ff THEN SAY line'.'
      ELSE fline=fline'0A'x||line'.'
    END
  ELSE
    DO
      line=line 'is missing.'
      IF ff THEN SAY line
      ELSE fline=fline'0A'x||line
      data.24=DELWORD(data.24,FIND(data.24,tempk),1)
    END
END
IF ff THEN
  DO
    CALL waiting()
    SAY
  END
ELSE
  DO
    IF writeopen(bbspath'EmailFiles/'name'/Marked')=0 THEN RETURN
    CALL WRITELN(f,fline)
    CALL CLOSE(f)
  END
RETURN


killmark:
PARSE ARG kdir kmsg .
IF data.24='' THEN RETURN
markword=FIND(data.24,kdir'/'kmsg)
IF markword>0 THEN data.24=STRIP(DELWORD(data.24,markword,1))
RETURN


readmarked:
mrknum=WORDS(data.24)
IF mrknum=0 THEN RETURN
SAY 'Reading only messages addressed to you...'
mrklist=data.24
msgcom=''
DO rmki=1 TO mrknum WHILE msgcom~='Q'
  tempk=WORD(mrklist,rmki)
  PARSE VAR tempk mkdir'/'mkmsg .
  IF ~EXISTS(msgpath||tempk) THEN
    DO
      CALL killmark(mkdir mkmsg)
      SAY
      SAY 'Message number' mkmsg 'in the' msg.mkdir 'conference is missing!'
      SAY
      ITERATE rmki
    END
  msgdir=mkdir
  savelast=lastread.msgdir
  CALL readmsg(1 mkmsg)
  IF mkmsg>savelast THEN lastread.msgdir=mkmsg
  ELSE lastread.msgdir=savelast
END
CALL saveData(1)
RETURN


sortnumbers:
PARSE ARG slist
IF STRIP(slist)='' THEN RETURN ''
sorted.=''
oldest=999999
newest=0
newlist=''
DO si=1 TO WORDS(slist)
  testword=WORD(slist,si)
  IF ~DATATYPE(testword,'W') THEN
    DO
      testpos=LASTPOS('.',testword)
      IF testpos>0 THEN tempnum=SUBSTR(testword,testpos+1)
      ELSE
        DO
          newlist=testword newlist
          ITERATE si
        END
    END
  ELSE tempnum=testword/1
  IF sorted.tempnum='' THEN
    DO
      sorted.tempnum=testword
      sorted.tempnum.0=1
      IF DATATYPE(tempnum,'W') THEN
        DO
          IF tempnum>newest THEN newest=tempnum
          IF tempnum<oldest THEN oldest=tempnum
        END
    END
  ELSE newlist=newlist testword
END
IF oldest~=999999 & newest~=0 THEN
  DO si=oldest TO newest
    IF sorted.si.0=1 THEN newlist=newlist sorted.si
  END
DROP sorted. oldest newest
RETURN STRIP(newlist)


readmail:
ARG fromenu .
replysubj=''
IF fromenu THEN
  DO
    temp=UPPER(arg)
    arg=''
    IF temp~='F' & temp~='T' & temp~='W' THEN
      DO
        line='Find Email ['pen3'F'def']rom You ['pen3'T'def']o You or ['pen3'W'def']rite New Email (ftw) > 'def
        temp=getinput(1 1 line)
        CALL cleanline(0)
      END
    IF temp='W' THEN
      DO
        CALL editor('MAIL')
        RETURN
      END
    ELSE IF temp='F' THEN
      DO
        firsteditline=0
        picklist.=''
        picklist.0=0
        IF getinput(1 1 'Check ALL users? (nY) > ')='N' THEN
          DO
            picklist.1=getinput(1 0 'Check EMail From' name 'To Who? > ')
            picklist.1=SPACE(STRIP(UPPER(picklist.1)),1,'_')
            picklist.1=COMPRESS(picklist.1,'.,:/*#?^ ')
            IF picklist.1='' THEN RETURN
            IF FIND(userlist,picklist.1)=0 THEN
              DO
                SAY '***'pen3 picklist.1 def'does not exist!'
                picklist.0=0
                RETURN
              END
            fmaillist=SHOWDIR(bbspath'EMail/'picklist.1)
            DO ej=1 TO WORDS(fmaillist)
              ejname=WORD(fmaillist,ej)
              uname=ejname
              caret=LASTPOS('.',uname)
              IF caret>2 THEN uname=LEFT(uname,caret-1)
              IF uname=name THEN
                DO
                  arg=bbspath'EMail/'picklist.1'/'ejname
                  IF EXISTS(arg) THEN
                    DO
                      pklst=picklist.0+1
                      picklist.pklst=picklist.1
                      picklist.pklst.0=ejname
                      picklist.0=pklst
                    END
                END
            END
            IF picklist.0=0 THEN SAY 'No Email FROM you was found.'
            ELSE
              DO
                SAY pen3'You have the following Email pending:'def
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        ELSE
          DO
            users=WORDS(userlist)
            SAY pen3'Scanning'def users pen3'email directories...'def||CR
            SAY pen3' - To ABORT, press CTRL-E -'def||CR
            DO wi=1 TO users
              CALL busywait(60 wi users)
              fmaillist=SHOWDIR(bbspath'EMail/'WORD(userlist,wi))
              DO ej=1 TO WORDS(fmaillist)
                ejname=WORD(fmaillist,ej)
                uname=ejname
                caret=LASTPOS('.',uname)
                IF caret>2 THEN uname=LEFT(uname,caret-1)
                IF uname=name THEN
                  DO
                    arg=bbspath'EMail/'WORD(userlist,wi)'/'ejname
                    IF EXISTS(arg) THEN
                      DO
                        pklst=picklist.0+1
                        picklist.pklst=WORD(userlist,wi)
                        picklist.pklst.0=ejname
                        picklist.0=pklst
                      END
                  END
              END
              IF wi=999999 THEN RETURN
            END
            CALL busywait(4 0)
            IF picklist.0=0 THEN SAY lineup'No Email FROM you was found.                    '
            ELSE
              DO
                SAY pen3'You have Email pending to the following users:'def
                pickcheck=1
                DO WHILE pickcheck~=0
                  pickcheck=pickfromlist()
                  IF pickcheck~=0 THEN
                    DO
                      firsteditline=5
                      IF level>sysoplevel THEN firsteditline=1
                      CALL bbsED(firsteditline bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0)
                      IF ~EXISTS(bbspath'Email/'picklist.pickcheck'/'picklist.pickcheck.0) THEN
                        picklist.pickcheck='- KILLED -'
                    END
                END
              END
          END
        DROP picklist.
        RETURN
      END
    ELSE IF temp='T' THEN BREAK
    ELSE RETURN
  END
SAY 'Checking your mailbox..'
nomail=1
CALL MAKEDIR(bbspath'EMail/'name)
mailist=sortnumbers(SHOWDIR(bbspath'Email/'name))
IF WORDS(mailist)=0 THEN
  DO
    SAY lineup'Your mailbox is empty.  '
    SAY
    RETURN
  END
line=WORDS(mailist)
IF line>1 THEN line=line 'letters'
ELSE line=line 'letter'
line=line 'waiting.'
SAY line
DO ii=1 TO WORDS(mailist)
  SAY 'Email:' pen3||WORD(mailist,ii)||def
END
IF ~fromenu THEN
  IF getinput(1 1 'Read your private mail now? (nY) > ')='N' THEN RETURN
onename=''
IF WORDS(mailist)>3 THEN
  DO
    IF getinput(1 1 'Read all private mail? (nY) > ')='N' THEN
      DO
        onename=getinput(1 0 'Read ONLY private mail from? > ')
        onename=SPACE(STRIP(UPPER(onename)),1,'_')
        onename=COMPRESS(onename,'.,:/*#?^ ')
        IF onename='' THEN RETURN
        IF FIND(userlist,onename)=0 & picklist.1~='BBBBS' THEN
          DO
            SAY '***'pen3 onename def'does not exist!'
            RETURN
          END
      END
  END
DO letter=1 TO WORDS(mailist)
  readname=WORD(mailist,letter)
  uname=readname
  caret=LASTPOS('.',uname)
  IF caret>2 THEN uname=LEFT(uname,caret-1)
  IF onename~='' & onename~=uname THEN ITERATE letter
  arg=bbspath'Email/'name'/'readname        /* user has mail! */
  CALL readlines(arg 1)
  delnum=WORD(lynes.1,2)
  CALL seelines(1)
  nomail=0
  nonstop=0
  mailfile=''
  IF UPPER(WORD(lynes.1,3))='FILE:' THEN mailfile=WORD(lynes.1,4)
  ELSE IF UPPER(WORD(lynes.2,3))='FILE:' THEN mailfile=WORD(lynes.2,4)
  IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' THEN
    DO
      IF LEFT(RIGHT(mailfile,4),1)~='.' & LEFT(readname,6)='BBBBS.' THEN
        DO
          SAY
          SAY pen3'The attached file is unarchived and may be incomplete.'
          SAY 'If the archiver is still building this file, downloading will fail.'def
          IF getinput(1 1 'Do you want to try to download it anyway? (Ny) > ')~='Y' THEN ITERATE letter
          SAY
        END
      curdir=PRAGMA('D')
      CALL setdir(bbspath'EmailFiles/'name)
      ADDRESS COMMAND 'C:List >*' mailfile 'DATES'
      SAY ' Attached file:' pen3||mailfile||def
      junk=getinput(1 1 'Leave file in your EmailFiles? (Ny) > ')
      IF junk='Y' THEN mailfile=''
      ELSE
        DO
          junk=getinput(1 1 'Deleting Mail will also delete file. Copy somewhere now? (Ny) > ')
          IF junk='Y' THEN
            DO
              savearg=arg
              arg=mailfile
              CALL dload()
              arg=savearg
            END
            CALL setdir(curdir)
        END
    END
  IF readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & LEFT(readname,3)~='MSG' & LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 '['pen3'A'def']gain  ['pen3'C'def']ontinue  ['pen3'R'def']eply? (acR) > ')
        IF tempchar='' THEN tempchar='R'
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='R' THEN
        DO
          IF WORDS(lynes.4)<2 THEN replysubj='NONE'
          ELSE replysubj=SUBSTR(lynes.4,WORDINDEX(lynes.4,2))
          CALL editor('MAIL' uname)
          replysubj=''
        END
    END
  IF LEFT(readname,6)~='BBBBS.' THEN
    DO
      tempchar='A'
      DO WHILE tempchar='A'
        tempchar=getinput(1 1 'Forward mail from'pen3 uname def'to other users? (aNy) > ')
        IF tempchar='A' THEN CALL seelines(1)
      END
      IF tempchar='Y' THEN
        DO
          IF selectchosen(1 pen3'Forward Email To: 'def)=0 THEN
            DO ei=1 TO thechosen.0 WHILE thechosen.ei~=''
              CALL MAKEDIR(bbspath'EMail/'thechosen.ei)
              forwardarg=bbspath'Email/'thechosen.ei'/'readname
              ADDRESS COMMAND 'C:COPY' bbspath'Email/'name'/'readname forwardarg
              CALL readlines(forwardarg 1)
              lynes.1=lynes.1'  Forwarded to you by' name TIME('C') DATE()
              CALL DELETE(forwardarg)
              CALL savelines(forwardarg)
              IF WORDS(lynes.2)>3 THEN
                DO
                  forname=bbspath'EmailFiles/'name'/'WORD(lynes.2,4)
                  IF EXISTS(forname) THEN
                    DO
                      CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ei)
                      ADDRESS COMMAND 'C:COPY' forname bbspath'EmailFiles/'thechosen.ei
                    END
                END
              line='Mail' pen3||readname||def 'forwarded to' pen3||thechosen.ei||def
              IF emailonline>=0 THEN emailonline=emailonline+1
              SAY line
            END
        END
    END
  tempchar=''
  tempstr='Delete the mail ('pen3||delnum||def') from'pen3 uname def'that you just read?'
  IF mailfile='' THEN tempchar=getinput(1 1 tempstr '(nqY) > ')
  ELSE
    DO WHILE tempchar~='N' & tempchar~='Q' & tempchar~='Y'
      tempchar=getinput(1 1 tempstr '(nqy) > ')
    END
  IF tempchar='Q' THEN
    DO
      IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
        DO
          readname=''
          uname=''
          RETURN
        END
    END
  ELSE IF tempchar~='N' THEN
    DO
      dirname=bbspath'Email/'name'/'
      nodelete=0
      IF bbsprefs.14=1 & name~=sysop & uname~=sysop & WORD(lynes.2,2)~='BBBBS' & WORD(lynes.2,2)~=sysop & WORD(lynes.3,2)~=sysop THEN
        nodelete=1
      IF nodelete THEN
        ADDRESS COMMAND 'C:Copy' dirname||readname bbspath'Email/'sysop
      ELSE emailonline=emailonline-1
      CALL DELETE(dirname||readname)
      tempstr='Old email'
      IF mailfile~='' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' & EXISTS(bbspath'EmailFiles/'name'/'mailfile) THEN
        DO
          IF nodelete THEN
            ADDRESS COMMAND 'C:Copy' bbspath'EmailFiles/'name'/'mailfile bbspath'EmailFiles/'sysop
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile)
          CALL DELETE(bbspath'EmailFiles/'name'/'mailfile'.xdl')
          tempstr=tempstr 'and attached file'
        END
      tempstr=tempstr 'deleted. Thank you for keeping a clean BBS!'
      SAY tempstr
      IF tempchar='Q' THEN
        IF getinput(1 1 'Quit reading your Email? (Ny) > ')='Y' THEN
          DO
            readname=''
            uname=''
            RETURN
          END
    END
  ELSE IF LEFT(readname,3)='MSG' & level>sysoplevel THEN
    DO
      ii=LEFT(readname,POS('.',readname)-1)
      ii=SUBSTR(ii,4)%1
      IF getinput(1 1 'Move this message back to the' msg.ii 'conference? (nY) > 'def)~='N' THEN
        DO
          temp=TRANSLATE(readname,'/','.')
          temp=SUBSTR(temp,4)
          lynes.1='!!'STRIP(lynes.1)
          edtype=''
          CALL savelines(msgpath||temp)
          CALL DELETE(bbspath'Email/'name'/'readname)
        END
    END
  ELSE IF LEFT(readname,3)~='MSG' & readname~='NEW_FILES' & readname~='FILELISTS_REPORT' & readname~='INACTIVE_USERS' THEN
    DO
      arg=bbspath'Email/'name'/'readname
      CALL readlines(arg 1)
      IF WORDS(lynes.5)<7 THEN
        DO
          lynes.5=lynes.5'  (Rcvd)' DATE('W') DATE() TIME('C')
          CALL DELETE(arg)
          CALL savelines(arg)
          SAY 'Email has been marked as received.'
        END
    END
  readname=''
  uname=''
  arg=''
END
IF nomail THEN
  DO
    SAY 'No mail was found.'
    CALL waiting()
  END
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN


selectchosen:
PARSE ARG startat selectline
IF startat<2 THEN thechosen.=''
line='Enter list of comma separated user names'
IF level>sysoplevel THEN line=line 'or ALL'
SAY line
thechosen.startat=getinput(1 0 selectline' ')
IF STRIP(thechosen.startat)='' THEN RETURN 1
thechosen.startat=SPACE(thechosen.startat,1,'_')
thechosen.0=startat
IF level>sysoplevel & thechosen.startat='ALL' THEN
  thechosen.startat=SHOWDIR(bbspath'Users','F',',')
IF POS(',',thechosen.startat)>0 THEN
  DO
    temp=TRANSLATE(thechosen.startat,' ',',')
    thechosen.0=thechosen.0+WORDS(temp)-1
    DO ei=1 TO WORDS(temp)
      eii=startat+ei-1
      thechosen.eii=STRIP(WORD(temp,ei))
    END
  END
DO ei=startat TO thechosen.0
  DO WHILE FIND(userlist,thechosen.ei)=0
    IF thechosen.ei~='' THEN
      DO
        IF FIND(exclusion,thechosen.ei)>0 | thechosen.ei='BBBBS' THEN
          DO
            thechosen.ei=sysop
            ITERATE ei
          END
        CALL loadcourtesy()
        IF FIND(courtesy,thechosen.ei)>0 THEN ITERATE ei
      END
    SAY thechosen.ei 'not found! Enter that name again or press RETURN.'
    thechosen.ei=getinput(1 0 pen3||selectline' 'def)
    IF thechosen.ei='' THEN
      DO
        IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
          CALL showuserlist()
        ITERATE ei
      END
    thechosen.ei=SPACE(thechosen.ei,1,'_')
  END
END
RETURN 0


countcheck:
PARSE ARG fname' 'cknum' '.
IF ~EXISTS(fname) THEN
  DO
    IF cknum=0 THEN RETURN 0
    IF ~writeopen(fname) THEN RETURN 0
    CALL WRITELN(f,cknum)
    CALL CLOSE(f)
    RETURN cknum
  END
IF ~readopen(fname) THEN RETURN cknum
retval=STRIP(READLN(f))
CALL CLOSE(f)
IF ~DATATYPE(retval,'W') THEN retval=0
IF ~DATATYPE(cknum,'W') THEN cknum=0
IF retval<cknum THEN
  DO
    IF writeopen(fname) THEN
      DO
        CALL WRITELN(f,cknum)
        CALL CLOSE(f)
        RETURN cknum
      END
  END
RETURN retval


pickfromlist:
DO pfl=1 TO picklist.0 BY 3
  pfl2=pfl+1
  pfl3=pfl+2
  pfline=pen3||RIGHT(pfl,3)||def LEFT(picklist.pfl,21)
  IF picklist.pfl2~='' THEN
    pfline=pfline pen3||RIGHT(pfl2,3)||def LEFT(picklist.pfl2,21)
  IF picklist.pfl3~='' THEN
    pfline=pfline pen3||RIGHT(pfl3,3)||def LEFT(picklist.pfl3,21)
  SAY pfline
END
emnum=getinput(1 0 pen3'Select Email Number > 'def)
IF ~DATATYPE(emnum,'W') | emnum<1 | emnum>picklist.0 THEN RETURN 0
RETURN emnum


sysED:
IF level<99 THEN RETURN
arg=getinput(0 0 'Textfile To Edit: ')
IF arg='' THEN RETURN
CALL bbsED(1 arg)
RETURN


bbsED:
PARSE ARG firstedit editarg .
notchanged=1
IF readlines(editarg 1) THEN RETURN 1
finfo=STATEF(editarg)
IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
ELSE finfo=''
SAY
SAY '                   'pen3'Entering the EDITOR module..'def
SAY
count=1
DO edloop=1
  IF edcom='S' & bbsprefs.5 THEN  /* spell check */
    DO
      SAY pen3'You must use ['def'R'pen3']eplace to make corrections.  'pen2'Spellchecking...'def
      CALL DELETE(scratch'/SpellLOCAL')
      CALL savelines(scratch'/SpellLOCAL')
      curdir=PRAGMA('D')
      CALL setdir(spellpath)
      CALL SpellChk.rexx(scratch'/SpellLOCAL')
      CALL setdir(curdir)
    END
  ELSE
    DO
      IF edcom='R' | edcom='I' | edcom='L' THEN CALL wrapbuf(7)
      IF edcom~='L' THEN count=count-linesperpage
      IF count>=lynes.0 | count<1 THEN count=1
      startcount=count
      DO i=startcount TO lynes.0+1
        IF ((i+1-startcount)//linesperpage)=0 THEN
          DO
            pline='                 ['pen3'E'def']dit'
            pline=pline '  ['pen3'RETURN'def']=Continue '
            edcom=getinput(1 1 pline)
            IF edcom~='' THEN LEAVE i
            CALL cleanline(1)
          END
        SAY pen3||RIGHT(i,2)||def lynes.i
        count=count+1
      END
    END
  SAY lineup'     ['pen3'A'def']ppend ['pen3'C'def']ut     ['pen3'I'def']nsert  ['pen3'K'def']ill       ['pen3'?'def'] Help'
  pline='     ['pen3'L'def']ist   ['pen3'P'def']aste   ['pen3'R'def']eplace'
  IF bbsprefs.5 THEN pline=pline '['pen3'S'def']pellcheck'
  pline=pline '['pen3'U'def']pload-Text > '
  edcom=getinput(1 0 pline)
  IF edcom='Q' | edcom='X' THEN edcom=''
  IF edcom='?' THEN
    DO
      SAY
      SAY '                   Editor Help'
      SAY '----------------------------------------------------------'
      SAY '    an empty RETURN tells the editor you are done editing.'
      SAY ' 7  edits line number 7, if it exists.'
      SAY ' a  Append text to this file.'
      SAY ' c  Cut selected line(s) of text to buffer.'
      SAY ' i  Insert blank line.'
      SAY ' k  Kill (delete) this file.'
      SAY ' l  List this file from selected line.'
      SAY ' p  Paste buffer contents to selected line number.'
      SAY ' r  Replace a phrase or line of text.'
      SAY ' s  Spellcheck this file.'
      SAY ' u  Upload a textfile to append to this file.'
      SAY '----------------------------------------------------------'
      SAY
      OPTIONS PROMPT ''
      PULL
    END
  IF edcom='K' THEN
    DO
      junk=getinput(1 1 'Are you' pen3'sure'def 'you want to delete' editarg'? (Ny) > ')
      IF junk='Y' THEN
        DO
          IF DELETE(editarg)=1 THEN SAY editarg 'DELETED.'
          IF WORD(lynes.1,1)='Mail:' & WORDS(lynes.2)>3 THEN
            DO
              IF DELETE(bbspath'EmailFiles/'WORD(lynes.3,2)'/'WORD(lynes.2,4))=1 THEN
                SAY WORD(lynes.2,4) 'DELETED.'
            END
          RETURN 2
        END
    END
  IF edcom='' THEN
    DO
      SAY '                   'pen3'Leaving the EDITOR module.'def
      IF notchanged THEN RETURN 0
      IF getinput(1 1 '                     Save changes? (nY)'pen3' > 'def)='N' THEN
        RETURN 1
      CALL DELETE(editarg)
      IF savelines(editarg) THEN RETURN 1
      CALL DELAY(28)
      IF finfo~='' THEN ADDRESS COMMAND 'C:filenote' editarg finfo
      SAY pen3'                        Changes saved.'def
      RETURN 0
    END
  ELSE IF edcom='C' THEN  /* Cut */
    DO
      firstnum=getinput(1 0 '   Enter line number or range 'pen3'(5-7)'def' to cut' pen3'>'def)
      IF firstnum='' THEN ITERATE edloop
      dash=POS('-',firstnum)
      IF dash>0 THEN
        DO
          lastnum=STRIP(SUBSTR(firstnum,dash+1))
          firstnum=STRIP(LEFT(firstnum,dash-1))
        END
      ELSE lastnum=firstnum
      IF ~DATATYPE(firstnum,'W') | ~DATATYPE(lastnum,'W') THEN
        DO
          junk=getinput(1 1 pen3'*** You must enter numbers here! 'def)
          ITERATE edloop
        END
      IF lastnum>lynes.0 THEN lastnum=lynes.0
      IF firstnum<firstedit THEN
        DO
          SAY '*** You are not authorized to delete that line!'
          SAY
          ITERATE edloop
        END
      IF firstnum>lastnum THEN
        DO
          SAY '*** Input error!  First number larger than last number'
          ITERATE edloop
        END
      notchanged=0
      numdiff=lastnum+1-firstnum
      pasted.=''
      pasted.0=numdiff
      k=0
      DO i=firstnum TO lynes.0
        j=i+numdiff
        k=k+1
        IF k<=numdiff THEN pasted.k=lynes.i
        lynes.i=lynes.j
        lynes.j=''
      END
      lynes.0=lynes.0-numdiff
      count=1
    END
  ELSE IF edcom='A' THEN  /* append */
    DO
      CALL writebuffer(scratch'/EditorLOCAL')
      notchanged=0
    END
  ELSE IF edcom='U' THEN  /* fileappend (upload) */
    DO
      frompath=GETCLIP('BBS_frompath')
      IF frompath='' THEN frompath=libpath'SysOps'
      farg=GetFile(150,36,frompath,'',' Select TextFile to Append ')
      IF farg~='' & EXISTS(farg) THEN
        DO
          CALL readlines(farg lynes.0+1)
          notchanged=0
          CALL SETCLIP('BBS_frompath',WORD(lastslash(farg),2))
        END
    END
  ELSE IF edcom='I' | edcom='R' | edcom='L' | edcom='P' | DATATYPE(edcom,'W') THEN
    DO
      IF DATATYPE(edcom,'W') THEN
        DO
          ednum=edcom
          edcom='R'
        END
      ELSE
        DO
          line=pen3'   '
          IF edcom='L' | edcom='P' THEN line=line'Starting '
          line=line'Line Number? > 'def
          ednum=getinput(1 0 line)
        END
      IF ~DATATYPE(ednum,'W') THEN ITERATE edloop
      IF ednum>(lynes.0+1) THEN ITERATE edloop
      IF edcom='L' THEN
        DO
          count=ednum
          ITERATE edloop
        END
      IF ednum=1 & UPPER(WORD(lynes.1,1))='FILE:' THEN
        DO
          IF getinput(1 1 pen3'Edit KeyWords:? (Ny) > 'def)='Y' THEN
            DO
              filenum=STRIP(WORD(lynes.1,2))
              num=files.filenum.0
              keywords=edkeywords(editarg)
              lynes.1=LEFT(lynes.1,21) keywords
              alpha.num=TRIM(OVERLAY(keywords,alpha.num,47,32))
              savefileflag=1
              notchanged=0
              ITERATE edloop
            END
        END
      IF ednum<firstedit THEN
        DO
          SAY '*** You are not authorized to alter that line!'
          SAY
          ITERATE edloop
        END
      IF edcom='R' THEN   /* replace */
        DO
          SAY '   Now reads:'
          SAY pen3||RIGHT(ednum,2)||def lynes.ednum
          OPTIONS PROMPT pen3'........Search text? >'def
          PARSE PULL stext
          IF LENGTH(stext)=0 THEN
            DO
              IF getinput(1 1 lineup||pen3'Replace entire line? (nY) >'def)='N' THEN
                ITERATE edloop
              lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)' 'def)
              notchanged=0
              ITERATE edloop
            END
          found=POS(UPPER(stext),UPPER(lynes.ednum))
          IF found=0 THEN
            DO
              SAY
              SAY stext' was not found!'
              SAY
              ITERATE edloop
            END
          OPTIONS PROMPT pen3'...Replacement text? >'def
          PARSE PULL rtext
          lynes.ednum=DELSTR(lynes.ednum,found,LENGTH(stext))
          lynes.ednum=INSERT(rtext,lynes.ednum,found-1)
          IF ednum<4 & LEFT(lynes.1,6)='File: ' THEN
            DO
              PARSE VAR lynes.1 'File: 'filenum . 'KeyWords: 'keywords
              PARSE VAR lynes.3 . 'Lib:' libnam
              filenum=STRIP(filenum)
              newc=files.filenum.0
              libnum=finddirnum(libnam)
              alpha.newc=LEFT(WORD(lynes.2,2),22-LENGTH(WORD(lynes.2,4)))
              alpha.newc=alpha.newc WORD(lynes.2,4) RIGHT(filenum,5)
              alpha.newc=alpha.newc RIGHT(libnum,2) LEFT(STRIP(libnam),12)
              alpha.newc=alpha.newc STRIP(LEFT(STRIP(keywords),32))
              savefileflag=1
            END
          SAY 'Done.'
          SAY
          notchanged=0
        END
      ELSE IF edcom='I' THEN  /* insert */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+1
            lynes.j=lynes.i
          END
          lynes.ednum=''
          notchanged=0
          lynes.0=lynes.0+1
          lynes.ednum=getinput(0 0 pen3||RIGHT(ednum,2)'>'def)
        END
      ELSE IF edcom='P' THEN   /* paste */
        DO
          DO i=lynes.0 TO ednum BY -1
            j=i+pasted.0
            lynes.j=lynes.i
          END
          DO k=1 TO pasted.0
            kk=ednum+k-1
            lynes.kk=pasted.k
          END
          notchanged=0
          lynes.0=lynes.0+pasted.0
        END
    END
END
RETURN 0


editor:
toname=''
msgnum=0
thechosen.=''
PARSE ARG edtype toname msgnum .
IF edtype='MAIL' THEN lastwrit=countcheck(bbspath'Numbers/LastMail 0')
ELSE
  DO
    IF edtype='MSG' THEN
      DO
        tempmsgdir=0
        IF DATATYPE(arg,'W') THEN tempmsgdir=arg
        IF tempmsgdir>0 & tempmsgdir<=level & msg.tempmsgdir~='' THEN
          msgdir=tempmsgdir
        ELSE IF areaselect() THEN RETURN
      END
    lastwrit=countcheck(bbspath'Numbers/LastMessage'msgdir 0)
  END
IF toname='' THEN
  DO
    IF edtype='MAIL' THEN
      DO
        CALL selectchosen(1 pen3'Send PRIVATE' edtype lastwrit+1 'To: 'def)
        toname=thechosen.1
      END
    ELSE toname=getinput(1 0 pen3'Post A PUBLIC Message To: 'def)
  END
toname=SPACE(STRIP(UPPER(toname)),1,'_')
toname=COMPRESS(toname,'.,:/*#?^ ')
IF toname='' | FIND(exclusion,toname)>0 THEN
  DO
    IF toname='' & edtype='MSG' THEN toname='ALL'
    ELSE toname=sysop
    SAY pen3'*** Re-Addressed to'def toname
  END
IF toname~='ALL' THEN
  DO
    IF toname='BBBBS' THEN toname=sysop
    IF FIND(userlist,toname)=0 THEN
      DO
        IF courtesy='' THEN CALL loadcourtesy()
        IF FIND(courtesy,toname)=0 THEN
          DO
            SAY
            SAY bak2' 'toname' is not on the user list! 'def
            IF edtype='MAIL' THEN
              DO
                CALL showuserlist()
                RETURN 0
              END
            ELSE
              DO
                IF getinput(1 1 'Do you want to use it anyway? (nY) > ')='N' THEN
                  DO
                    IF getinput(1 1 'Do you want to see the list of current users? (Ny) > ')='Y' THEN
                      CALL showuserlist()
                    RETURN 0
                  END
              END
          END
      END
  END
IF edtype='MAIL' THEN
  DO
    CALL MAKEDIR(bbspath'EMail/'toname)
    mailname=bbspath'EMail/'toname'/'name'.'lastwrit+1
  END
ELSE
  DO
    CALL MAKEDIR(msgpath||msgdir)
    mailname=msgpath||msgdir'/'lastwrit+1
  END
lynes.=''
lynes.0=6
IF edtype='MAIL' THEN lynes.1=' Mail:' lastwrit+1  /* FILE: filename */
ELSE lynes.1='  Msg:' lastwrit+1          /* Msg: MSG# REPLY # # ... */
lynes.2=' From:' name
IF city~='' THEN lynes.2=lynes.2' - 'city
lynes.3='   To:' toname                       /*  To: toname   MSG # */
IF edtype='MAIL' THEN
  DO
    IF readopen(bbspath||'Users/'toname) THEN
      DO
        CALL READLN(f)
        CALL READLN(f)
        temp=READLN(f)
        CALL CLOSE(f)
        temp=docity(temp)
        IF temp~='' THEN lynes.3=lynes.3' - 'temp
      END
    IF replysubj='|@NEW@|' THEN
      DO
        CALL readlines(bbspath'BBS_TEXT/EMAIL_WELCOME' 7)
        replysubj='Welcome to' bbsname
      END
  END
subj=''
IF edtype='REPLY' THEN
  DO
    subj=SUBSTR(forthline,WORDINDEX(forthline,2))
    SAY pen3'Subj:'def subj
    temp=getinput(0 0 'Change the current subject? (Ny) > ')
    IF LENGTH(temp)>3 THEN subj=temp
    ELSE IF LEFT(UPPER(temp),1)='Y' THEN subj=''
  END
ELSE IF edtype='MAIL' & replysubj~='' THEN subj=replysubj
IF subj='' THEN
  DO
    IF opt='C' THEN subj='FEEDBACK'
    ELSE
      DO
        SAY pen3'Enter the'def 'Subject' pen3'of this message (1 line).'def
        subj=getinput(0 0 pen3': 'def)
      END
  END
IF LENGTH(subj)>66 THEN subj=LEFT(subj,66)
IF subj='' THEN subj='?'
lynes.4=' Subj:' subj
lynes.5=' Date:' DATE('W') DATE()'  'TIME('C')
IF edtype~='MAIL' THEN lynes.5=LEFT(lynes.5,39) 'Conference:' msg.msgdir
lynes.6=LEFT('',74,'=')
IF edtype='REPLY' THEN lynes.3=lynes.3'  MSG 'msgnum
DO i=1 TO lynes.0
  SAY lynes.i
END
CALL writebuffer(scratch'/MessageLOCAL')
IF savelines(mailname) THEN RETURN 0
CALL seelines(1)
IF thechosen.0='' THEN
  DO
    thechosen.0=1
    thechosen.1=toname
  END
carbons=thechosen.0+1
DO FOREVER
  IF thechosen.0>=carbons THEN
    DO
      junk='Copies To:'
      DO cci=carbons TO thechosen.0
        junk=junk thechosen.cci
      END
      SAY junk
    END
  pline=''
  IF edtype='MAIL' THEN pline='['pen3'C'def']opies'
  pline=STRIP(pline '['pen3'E'def']dit ['pen3'K'def']ill ['pen3'R'def']ead')
  pline=pline '['pen3'U'def']pload-Text ['pen3'S'def']end' edtype'? (ekrSu) 'def
  junk=getinput(1 1 pline)
  IF junk='E' THEN
    DO
      IF level>sysoplevel THEN firstedit=1
      ELSE firstedit=7
      IF bbsED(firstedit mailname)=2 THEN RETURN 0
      junk='R'
    END
  ELSE IF edtype='MAIL' & junk='C' THEN
    DO
      CALL selectchosen(carbons pen3'Carbon Copies To: 'def)
      junk='R'
    END
  ELSE IF junk='K' THEN
    DO
      IF DELETE(mailname)=1 THEN SAY edtype 'DELETED.'
      RETURN 0
    END
  ELSE IF junk='U' THEN
    DO
      SAY 'Ready to append' pen3'TEXT ONLY'def
      pline='Are you SURE your file is un-compressed text? (Ny) > '
      IF getinput(1 1 pline)='Y' THEN
        DO
          arg='UploadLOCAL'
          curdir=PRAGMA('D')
          CALL setdir(scratch)
          CALL DELETE(arg)
          CALL DELETE('tempLOCAL')
          IF uload(0)=0 THEN
            DO
              ADDRESS COMMAND 'C:copy' mailname 'tempLOCAL'
              CALL DELETE(mailname)
              ADDRESS COMMAND 'C:join tempLOCAL UploadLOCAL AS' mailname
            END
          CALL setdir(curdir)
        END
      junk='R'
    END
  IF junk='R' THEN
    DO
      CALL readlines(mailname 1)
      CALL seelines(1)
      nonstop=0
    END
  ELSE BREAK
END
IF edtype='MAIL' THEN
  DO
    IF replysubj~='' & readname~='' & LEFT(readname,5)~='BBBBS' & uname~='' & uname~='UNAME' THEN
      DO
        junk=getinput(1 1 'Attach original mail from' uname'? (nY) > ')
        IF junk~='N' THEN
          DO
            arg=bbspath'Email/'name'/'readname
            IF ~readlines(arg 1) THEN CALL savelines(mailname)
          END
      END
    junk=getinput(1 1 pen3'Attach a file to this message? (Ny) > 'def)
    IF junk='Y' THEN
      DO
        savearg=arg
        arg=''
        curdir=PRAGMA('D')
        CALL MAKEDIR(bbspath'EmailFiles/'toname)
        CALL setdir(bbspath'EmailFiles/'toname)
        IF uload(0)=0 THEN
          DO
            IF WORD(STATEF(bbspath'EmailFiles/'toname'/'arg),2)>1 THEN
              DO
                CALL readlines(mailname 1)
                IF arg~='' THEN lynes.1=lynes.1'  FILE: 'arg
                CALL setdir(curdir)
                CALL DELETE(mailname)
                CALL savelines(mailname)
              END
          END
        ELSE
          DO
            CALL DELETE(bbspath'EmailFiles/'toname'/'arg)
            SAY pen3'*** Upload failed! ***'def
          END
        arg=savearg
      END
    totmail=WORD(data.17,2)
    IF ~DATATYPE(totmail,'W') THEN totmail=1
    ELSE totmail=totmail+1
    data.17=WORD(data.17,1)'  'totmail'  'WORD(data.17,3)
  END
IF edtype~='MAIL' THEN totwrit.msgdir=totwrit.msgdir+1
CALL readlines(mailname 1)
DO ui=1 TO thechosen.0
  IF thechosen.ui='' THEN ITERATE ui
  IF ui>1 THEN
    DO
      CALL MAKEDIR(bbspath'Email/'thechosen.ui)
      newname=bbspath'Email/'thechosen.ui'/'name'.'lastwrit+1
      IF ui<carbons THEN lynes.3='   To:' thechosen.ui
      ELSE
        DO
          lynes.1=lynes.1'  (Carbon Copy)'
          lynes.3='   To:' thechosen.1
        END
      CALL savelines(newname)
      IF WORDS(lynes.1)>3 & EXISTS(bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4)) THEN
        DO
          CALL MAKEDIR(bbspath'EmailFiles/'thechosen.ui)
          ADDRESS COMMAND 'C:COPY' bbspath'EmailFiles/'thechosen.1'/'WORD(lynes.1,4) bbspath'EmailFiles/'thechosen.ui
          line2='Copied' WORD(lynes.1,4)
          SAY line2 'to the' thechosen.ui 'file area.'
        END
    END
  IF edtype~='MAIL' THEN
    DO
      IF FIND(userlist,thechosen.ui)>0 THEN
        CALL msgmark(thechosen.ui msgdir lastwrit+1)
    END
  IF GETCLIP('BBS_level')~='' & WORD(GETCLIP('BBS_lastcaller'),1)=thechosen.ui THEN
    DO
      temp='new Email.'
      IF edtype~='MAIL' THEN
        temp='a new message addressed to you in the'pen3 msg.msgdir def'conference.'
      oldmess=GETCLIP('BBS_MESSAGE')
      IF oldmess~='' THEN oldmess=oldmess||'0D0A'x
      CALL SETCLIP('BBS_MESSAGE',oldmess||'You have' temp)
    END
  line=edtype 'Sent To' thechosen.ui
  IF edtype='MAIL' THEN
    DO
      IF emailonline>=0 THEN emailonline=emailonline+1
    END
  ELSE
    DO
      grand=grand+1
      IF ~DATATYPE(msg.msgdir.0,'W') THEN msg.msgdir.0=1
      ELSE msg.msgdir.0=msg.msgdir.0+1
      line=line 'in the'pen3 msg.msgdir def'conference.'
    END
  SAY line
END
IF edtype='MAIL' THEN CALL countcheck(bbspath'Numbers/LastMail' lastwrit+1)
ELSE CALL countcheck(bbspath'Numbers/LastMessage'msgdir lastwrit+1)
CALL setdir(libpath||dirs.1)
thechosen.=''
RETURN 1


msgmark:
PARSE ARG markname markdir markmsg .
IF OPEN(f,bbspath'Users/'markname,'R')=0 THEN RETURN
mlines.=''
DO mi=1
  temp=READLN(f)
  IF EOF(f) THEN LEAVE mi
  mlines.mi=STRIP(temp)
END
CALL CLOSE(f)
mlines.0=mi-1
CALL DELAY(28)
mlines.24=STRIP(mlines.24 markdir'/'markmsg)
IF OPEN(f,bbspath'Users/'markname,'W')=0 THEN RETURN
DO mi=1 TO mlines.0
  CALL WRITELN(f,mlines.mi)
END
CALL CLOSE(f)
RETURN


shell:
SAY
olddir=PRAGMA('D')
DO WHILE(UPPER(opt)~='EXIT')
  SAY bak2||TIME('C')||def PRAGMA('D')
  OPTIONS PROMPT pen3'Type EXIT to quit AmigaDOS> 'def
  PARSE PULL opt' 'arg
  IF(UPPER(opt)='CD') THEN CALL setdir(arg)
  ELSE IF exists(opt)~=0 THEN
    DO
      IF LEFT(STATEF(opt),3)='DIR' THEN CALL setdir(opt)
    END
  ELSE IF opt~='' & UPPER(opt)~='EXIT' THEN
    ADDRESS COMMAND opt '<* >*' arg
END
CALL PRAGMA('D',olddir)
RETURN


bbsspace:
ARG tabspace .
ADDRESS COMMAND 'C:info >ram:locinfout' bbsdevice
ok=OPEN(f,'ram:locinfout','R')
IF ok=0 THEN RETURN 20
line=READLN(f)
line=READLN(f)
line=READLN(f)
line=READLN(f)
CALL CLOSE(f)
IF tabspace<14 THEN SAY
bbsk=WORD(line,4)
IF ~DATATYPE(bbsk,'N') THEN
  DO
    line=bbsdevice 'is not an info compatible device!'
    SAY pen3||line||def
    bbsk=0
    RETURN
  END
bbsk=bbsk*512-SYSTEM_SPACE_LIMIT
IF bbsk<1 THEN bbsk=0
SAY RIGHT(comma(bbsk),tabspace) 'bytes available for uploads.'
RETURN


comma:
ARG num .
dgt=LENGTH(num)
numtext=''
IF dgt>3 THEN numtext=','RIGHT(num,3)
IF dgt>6 THEN numtext=','LEFT(RIGHT(num,6),3)||numtext
IF dgt>9 THEN numtext=','LEFT(RIGHT(num,9),3)||numtext
IF dgt>12 THEN
  DO
    numtext=','LEFT(RIGHT(num,12),3)||numtext
    numtext=LEFT(num,dgt-12)||numtext
  END
ELSE IF dgt>9 THEN numtext=LEFT(num,dgt-9)||numtext
ELSE IF dgt>6 THEN numtext=LEFT(num,dgt-6)||numtext
ELSE IF dgt>3 THEN numtext=LEFT(num,dgt-3)||numtext
ELSE numtext=num
RETURN numtext


is_here:
ARG newname
SAY 'Checking filelist...'
DO wi=1 TO 99
  IF wi//3=0 THEN CALL WRITECH(STDOUT,'.')
  IF dirs.wi='' THEN ITERATE wi
  IF ~EXISTS(bbspath'FileNotes/'dirs.wi'/'newname) THEN ITERATE wi
  line=pen3'*** File' newname 'already exists here'
  IF wi<=level THEN line=line 'in the' dirs.wi 'directory'
  line=line'.'def
  SAY line
  SAY 'Original uploader should ['pen3'K'def']ill the file before uploading the replacement.'
  CALL waiting()
  RETURN 1
END
CALL cleanline(1)
RETURN 0


uload:
ARG frommenu
CALL bbsspace(12)
SAY
IF bbsk<1 THEN
  DO
    SAY pen3'Upload area is full!'def
    RETURN 1
  END
IF arg='' THEN
  DO
    frompath=GETCLIP('BBS_frompath')
    IF frompath='' THEN frompath=libpath'SysOps'
    fdir=''
    fromfile=GetFile(150,36,frompath,'',' Select File to Upload ')
    IF fromfile='' THEN RETURN 1
    x=LASTPOS('/',fromfile)
    IF x=0 THEN x=POS(':',fromfile)
    IF x>0 THEN
      DO
        arg=SUBSTR(fromfile,x+1)
        fdir=LEFT(fromfile,x)
        IF RIGHT(fdir,1)='/' THEN fdir=LEFT(fdir,x-1)
        CALL SETCLIP('BBS_frompath',fdir)
      END
    ELSE arg=fromfile
  END
ELSE fromfile=PRAGMA('D')'/'arg
arg=COMPRESS(arg,' :/,;|#?*()+[]"{}')  /* be sure no illegals here */
x=LASTPOS('/',arg)
IF x=0 THEN x=LASTPOS(':',arg)
IF x>0 THEN
  DO
    IF DATATYPE(SUBSTR(arg,x+1),'W') THEN
      DO
        SAY 'Whole numbers are not allowed as filenames!'
        CALL waiting()
        RETURN 1
      END
  END
tempnum=LENGTH(arg)-16
DO WHILE tempnum>0 & POS('EMAILFILES',UPPER(PRAGMA('D')))=0
  temp='          'pen3||arg def'is'pen3 tempnum||def
  IF tempnum=1 THEN temp=temp 'character'
  ELSE temp=temp 'characters'
  temp=temp 'too long for a filename.'
  SAY temp
  arg=getinput(0 0 'Filename: ')
  arg=cleanstring('0:'arg)
  arg=COMPRESS(arg,' :/,;|#?*')
  tempnum=LENGTH(arg)-16
END
IF arg='' THEN RETURN 1
IF frommenu THEN
  DO
    IF is_here(arg) THEN RETURN 1
    IF bbsprefs.6=1 & sysoplevel>level THEN CALL setdir(libpath'Sysops')
    ELSE
      DO
        SAY 'Please select an appropriate library for -' pen3||arg def'-'
        IF chdir()>0 THEN RETURN
      END
  END
ADDRESS COMMAND 'C:COPY' fromfile PRAGMA('D')'/'arg
IF TestArc.rexx(PRAGMA('D')'/'arg)>0 THEN
  DO
    SAY
    SAY pen3'***'def arg pen3'failed archive check!'def
    SAY
    temp=getinput(1 1 'Do you believe the archive checker made a mistake? (Ny) > ')
    IF temp~='Y' THEN
      DO
        CALL DELETE(arg)
        SAY
        RETURN 2
      END
  END
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN 0
DO ui=sysoplevel+2 TO 100
  IF UPPER(dirs.ui)=UPPER(plaindir) THEN RETURN 0
END
IF frommenu THEN
  DO WHILE editnote(bbspath'FileNotes/'plaindir'/'arg) /* INSIST on a filenote */
  END
RETURN 0


findfiles:
PARSE ARG ffile .
IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN RETURN ffile
wi=0
IF DATATYPE(ffile,'W') THEN
  DO
    IF WORDS(files.ffile)<2 THEN RETURN 0
    dirtemp=WORD(files.ffile,1)
    IF finddirnum(dirtemp)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
      DO
        CALL illegal_access()
        RETURN 0
      END
    CALL setdir(libpath||dirtemp)
  END
ELSE IF EXISTS(ffile) THEN
  DO
    IF EXISTS(bbspath'FileNotes/'plaindir'/'ffile) THEN
      DO
        IF readopen(bbspath'FileNotes/'plaindir'/'ffile)~=0 THEN
          DO
            line=READLN(f)
            CALL CLOSE(f)
            ffile=WORD(line,2)
          END
      END
  END
ELSE IF EXISTS(bbspath'Information'ffile) THEN
  RETURN bbspath'Information/'ffile
ELSE
  DO
    nextfilenum=countcheck(bbspath'Numbers/LastFile' 0)+1
    CALL busywait(4 1)
    DO ni=nextfilenum TO 0 BY -1
      IF ni<1 THEN
        DO
          CALL busywait(4 0)
          SAY '***' files.0 'filenames scanned,'pen3 ffile def'was not found!'
          RETURN 0
        END
      IF ni>1 THEN CALL busywait(60 ni nextfilenum)
      argtemp=WORD(files.ni,2)
      IF UPPER(argtemp)=UPPER(ffile) THEN
        DO
          dirtemp=WORD(files.ni,1)
          jj=files.ni.0
          IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(dirtemp))>0 THEN
            DO
              CALL busywait(4 0)
              CALL illegal_access()
              RETURN 0
            END
          ffile=ni
          CALL setdir(libpath||dirtemp)
          LEAVE ni
        END
    END
    CALL busywait(4 0)
  END
ftemp=ffile
IF DATATYPE(ftemp,'W') THEN ftemp=WORD(files.ftemp,2)
IF ~EXISTS(ftemp) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'ftemp)
    IF WORDS(finfo)>7 THEN ftemp=WORD(finfo,8)
    IF ~EXISTS(ftemp) THEN
      DO
        IF finfo='' THEN SAY '***'pen3 PRAGMA('D')'/'ftemp def'was not found!'
        ELSE
          DO
            SAY
            SAY '***'pen3 plaindir'/'ftemp def'is not currently available online.'
            SAY 'Please leave email to your sysop'pen3 sysop||def', to receive this file.'
            SAY
          END
        RETURN 0
      END
  END
RETURN ffile


illegal_access:
SAY
SAY '*** You are not authorized to access' ffile'!'
SAY '*** Send Email to' sysop 'to receive a higher level.'
SAY
RETURN


ext_dload:
SAY
arg=bbsExtDL.baud(name level TRUNC(maxtime-TIME('E')) linesperpage colorflag extdevs)
IF arg~='' THEN SAY 'Sorry, LOCAL mode cannot download from the Extra Devices.'
RETURN


dload:
arg=STRIP(arg data.25)
data.25=''
errorflag=0
curdir=PRAGMA('D')
OPTIONS PROMPT 'Filename and/or number: '
IF arg='' THEN PARSE PULL arg  /* no filename given */
IF arg='' THEN RETURN 0
IF findfiles(arg)=0 THEN RETURN 0
arg=TRANSLATE(arg,'  ',':/')
IF WORDS(arg)>1 THEN arg=WORD(arg,1)
IF DATATYPE(arg,'W') THEN
  DO
    CALL setdir(libpath||WORD(files.arg,1))
    arg=WORD(files.arg,2)
  END
IF arg~='' THEN           /* check for filename */
  DO dloadloop=1
    frompath=GETCLIP('BBS_frompath')
    IF frompath='' THEN frompath=libpath'SysOps/'
    notename=bbspath'FileNotes/'plaindir'/'arg
    IF ~EXISTS(arg) THEN
      DO
        finfo=STATEF(notename)
        IF WORDS(finfo)>7 THEN
          DO
            temp=plaindir
            x=lastslash(WORD(finfo,8))
            arg=WORD(x,1)
            CALL setdir(WORD(x,2))
            plaindir=temp
          END
      END
    topath=PRAGMA('D')
    num=LASTPOS('/',arg)
    IF num=0 THEN num=LASTPOS(':',arg)
    IF num>0 THEN
      DO
        topath=LEFT(arg,num)
        arg=SUBSTR(arg,num+1)
      END
    IF RIGHT(topath,1)~=':' & RIGHT(topath,1)~='/' THEN topath=topath'/'
    SAY ' Select Filename to Copy ' topath||arg 'To:'
    tofile=GetFile(150,36,frompath,arg,' Select Destination Name ')
    IF tofile='' THEN
      DO
        errorflag=1
        LEAVE dloadloop
      END
    ADDRESS COMMAND 'C:Copy' topath||arg tofile
    CALL SETCLIP('BBS_frompath',WORD(lastslash(tofile),2))
    IF POS('EMAILFILES',UPPER(PRAGMA('D')))>0 THEN LEAVE dloadloop
    DO di=sysoplevel+2 TO 100
      IF UPPER(dirs.di)=UPPER(plaindir) THEN LEAVE dloadloop
    END
    IF readlines(notename 1) THEN LEAVE dloadloop
    dls=WORD(lynes.2,7)
    IF ~DATATYPE(dls,'W') THEN dls=0
    lynes.2=STRIP(DELWORD(lynes.2,7,1)) dls+1
    finfo=STATEF(notename)
    IF WORDS(finfo)>7 THEN finfo=SUBSTR(finfo,WORDINDEX(finfo,8))
    ELSE finfo=''
    CALL DELETE(notename)
    CALL savelines(notename)
    CALL DELAY(28)
    IF finfo~='' THEN ADDRESS COMMAND 'C:FileNote' notename finfo
    LEAVE dloadloop
  END
CALL setdir(curdir)
IF errorflag THEN SAY pen3'*** Download Failed!'def
RETURN errorflag


lastslash:
PARSE ARG sarg
sdir=''
slash=LASTPOS('/',sarg)
IF slash>2 THEN sdir=LEFT(sarg,slash-1)
ELSE
  DO
    slash=LASTPOS(':',sarg)
    IF slash>0 THEN sdir=LEFT(sarg,slash)
  END
IF slash>0 THEN sarg=SUBSTR(sarg,slash+1)
RETURN sarg sdir


editnote:
IF arg='' THEN
  DO
    PARSE PULL arg .
    IF arg='' THEN RETURN 0
  END
comment=''
IF ~EXISTS(arg) THEN
  DO
    finfo=STATEF(bbspath'FileNotes/'plaindir'/'arg)
    fromarg=arg
    fromdir=GETCLIP('BBS_frompath')
    IF WORDS(finfo)>7 THEN
      DO
        temp='Y'
        fromdir=WORD(finfo,8)
        fromdir=lastslash(fromdir)
        fromarg=WORD(fromdir,1)
        fromdir=WORD(fromdir,2)
      END
    ELSE
      DO
        IF level<sysoplevel THEN RETURN 0
        temp=getinput(1 1 'Is this file on an another device? (Nqy)')
      END
    IF fromdir='' THEN fromdir=libpath'Sysops'
    IF temp='Y' THEN
      DO WHILE comment=''
        comment=GetFile(150,36,fromdir,fromarg,' Select Linked File ')
        IF comment='' THEN RETURN 0
        IF ~EXISTS(comment) THEN comment=''
        ELSE CALL SETCLIP('BBS_frompath',WORD(lastslash(comment),2))
      END
    ELSE IF temp~='N' THEN RETURN 0
  END
IF comment='' THEN
  DO
    arg=findfiles(arg)
    IF arg=0 THEN RETURN 0
    IF DATATYPE(arg,'W') THEN arg=WORD(files.arg,2)
  END
filedir=plaindir
slash=LASTPOS('/',arg)
IF slash=0 THEN slash=LASTPOS(':',arg)
IF slash>0 THEN
  DO
    filedir=LEFT(arg,slash-1)
    filedir=SUBSTR(filedir,5)
    arg=SUBSTR(arg,slash+1)
  END
ELSE filedir=plaindir
CALL MAKEDIR(bbspath'FileNotes/'filedir)
IF ~EXISTS(bbspath'FileNotes/'filedir) THEN
  DO
    SAY pen3'*** Failed to open directory!' filedir||def
    RETURN 0
  END
notename=bbspath'FileNotes/'filedir'/'arg
lynes.=''
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF level>sysoplevel THEN firstedit=1
ELSE firstedit=5
IF EXISTS(notename) THEN
  DO
    IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
    CALL bbsED(firstedit notename)
    RETURN 0
  END
IF comment='' THEN filedata=STATEF(libpath||filedir'/'arg)
ELSE filedata=STATEF(comment)
IF filedata='' THEN
  DO
    IF comment='' THEN line=filedir'/'arg
    ELSE line=comment
    SAY line 'does not exist!'
    RETURN 0
  END
bytes=WORD(filedata,2)
filenum=filenum+1
lynes.0=4
lynes.1='File: 'LEFT(filenum,5)' KeyWords:'
lynes.2='Name: 'LEFT(arg,27)' Size: 'bytes' bytes   Downloads: 0'
lynes.3='From: 'LEFT(name,27)' Date: 'DATE() TIME('C')'  Lib: 'filedir
lynes.4=LEFT('',74,'=')
lynes.1=lynes.1 edkeywords(arg filedir)
CALL seelines(1)
edtype=''
CALL writebuffer(scratch'/NoteLOCAL')
IF savelines(notename) THEN RETURN 0
IF comment~='' THEN ADDRESS COMMAND 'C:filenote' notename comment
fncom='R'
DO WHILE fncom='R'
  CALL seelines(1)
  nonstop=0
  line='['pen3'E'def']dit'
  IF level>sysoplevel THEN line=line '['pen3'K'def']ill'
  line=line '['pen3'R'def']ead ['pen3'S'def']ave'
  IF level>sysoplevel THEN line=line '(ekrS) 'def
  ELSE line=line '(erS) 'def
  fncom=getinput(1 1 line)
  IF fncom='K' & level>sysoplevel THEN
    DO
      SAY 'Killing FileNote..'
      CALL DELETE(notename)
      RETURN 1
    END
  ELSE IF fncom='E' THEN
    DO
      IF bbsED(firstedit notename)>0 THEN RETURN 0
      fncom='R'
    END
  ELSE IF fncom~='R' THEN
    DO
      SAY 'Adjusting filelist...'
      IF filenum<1 THEN filenum=1
      IF GETCLIP('BBS_level')~='' THEN CALL SETCLIP('BBS_localfiles',1)
      CALL countcheck(bbspath'Numbers/LastFile' filenum)
      files.0=files.0+1
      newcount=alpha.0+1
      alpha.0=newcount
      files.filenum=plaindir arg
      files.filenum.0=newcount
      libnum=finddirnum(plaindir)
      PARSE VAR lynes.1 . 'KeyWords:' keywords
      alpha.newcount=LEFT(arg,22-LENGTH(WORD(lynes.2,4)))
      alpha.newcount=alpha.newcount WORD(lynes.2,4) RIGHT(filenum,5)
      alpha.newcount=alpha.newcount RIGHT(libnum,2) LEFT(plaindir,12)
      alpha.newcount=alpha.newcount STRIP(LEFT(STRIP(keywords),32))
      IF EXISTS(bbspath'Lists/Files') THEN
        x=OPEN(f,bbspath'Lists/Files','A')
      ELSE x=OPEN(f,bbspath'Lists/Files','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files'
          RETURN 0
        END
      CALL WRITELN(f,filenum files.filenum)
      CALL CLOSE(f)
      IF EXISTS(bbspath'Lists/Files.ALPHA') THEN
        x=OPEN(f,bbspath'Lists/Files.ALPHA','A')
      ELSE x=OPEN(f,bbspath'Lists/Files.ALPHA','W')
      IF x=0 THEN
        DO
          SAY '*** Failed to open' bbspath'Lists/Files.ALPHA'
          RETURN 0
        END
      CALL WRITELN(f,alpha.newcount)
      CALL CLOSE(f)
      sortalphaflag=1
      savefileflag=1
    END
END
RETURN 0


edkeywords:
PARSE ARG kwarg
templine=''
DO WHILE LENGTH(templine)<3
  SAY
  SAY pen3'Please enter a list of keywords (or a condensed description)'def
  SAY pen3'to be used in the alphabetic list and by the search routine.'def
  SAY '    Note that only the first 32 characters will be used.'
  SAY LEFT('',43)'|'LEFT('',31,'=')'|'
  templine=getinput(0 0 ' 'RIGHT(STRIP(RIGHT(kwarg,32)),32) pen3'KeyWords: 'def)
  templine=cleanstring('0:'templine)
  templine=STRIP(LEFT(templine,32))
  SAY
END
RETURN templine


loadfiles:
SAY def
SAY 'Loading filelist...'
files.=''
files.0=0
IF readopen(bbspath'Lists/Files') THEN
  DO
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      num=WORD(line,1)
      IF DATATYPE(num,'W') THEN files.num=WORD(line,2) WORD(line,3)
    END
    files.0=i-1
    CALL CLOSE(f)
  END
RETURN


savefilelist:
IF level=99 THEN
  IF getinput(1 1 'Update filelists now? (nY) > ')='N' THEN RETURN

savefilelist2:
SIGNAL OFF BREAK_E
IF ckmaint('FILES') THEN RETURN
CALL savealphalist()
SAY 'Saving filelist...'
CALL SETCLIP('BBS_maint',1)
xarg=bbspath'Lists/Files'
CALL DELETE(xarg)
filenum=countcheck(bbspath'Numbers/LastFile' 0)
IF filenum<1 | writeopen(xarg)=0 THEN RETURN
DO i=1 TO filenum
  IF files.i='' THEN ITERATE
  CALL WRITELN(f,i files.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
savefileflag=0
IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
RETURN


loadalpha:
SAY def
SAY 'Loading the alphabetical filelist...'
IF readopen(bbspath'Lists/Files.ALPHA') THEN
  DO
    alpha.=''
    alpha.0=0
    DO i=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      fnum=WORD(line,3)
      IF DATATYPE(fnum,'W') THEN
        DO
          alpha.i=line
          files.fnum.0=i
        END
      ELSE i=i-1
    END
    CALL CLOSE(f)
    alpha.0=i-1
    IF alpha.0<files.0 THEN buildalpha=1
  END
ELSE SAY pen3'*** Lists/Files.ALPHA failed to open for reading!'def
SAY
RETURN


ckmaint:
ARG ckfile .
IF GETCLIP('BBS_maint')~='' THEN
  DO
    DO i=0 TO 23 WHILE GETCLIP('BBS_maint')~=''
      IF i//2=0 THEN SAY 'Waiting' (24-i)*5 'more seconds for' ckfile 'list update to finish...'
      CALL DELAY(250)
    END
    IF i>23 THEN
      DO
        SAY '*** unable to update' ckfile 'list.'
        RETURN 1
      END
  END
RETURN 0


savealphalist:
SIGNAL OFF BREAK_E
IF ckmaint('ALPHA') THEN RETURN
CALL SETCLIP('BBS_maint',1)
IF GETCLIP('BBS_mainfiles')~='' & GETCLIP('BBS_maint')='' THEN
  DO
    CALL SETCLIP('BBS_mainfiles')
    CALL loadfiles()
    CALL loadalpha()
  END
aarg=bbspath'Lists/Files.ALPHA'
CALL DELETE(aarg)
IF sortalphaflag=1 THEN
  DO
    SAY 'Alphabetizing' alpha.0 'files...'
    CALL QSORT(1,alpha.0,alpha)
    DO i=1 TO alpha.0
      fnum=WORD(alpha.i,3)
      files.fnum.0=i
    END
  END
sortalphaflag=0
IF writeopen(aarg)=0 THEN
  DO
    SAY '*** Error opening' aarg '!'
    CALL SETCLIP('BBS_maint')
    RETURN
  END
SAY 'Saving alphabetical filelist...'
DO i=1 TO alpha.0
  ii=WORD(alpha.i,3)
  IF files.ii='' THEN alpha.i='0 0' ii '100'
  IF LEFT(alpha.i,4)~='0 0 ' THEN CALL WRITELN(f,alpha.i)
END
CALL CLOSE(f)
CALL SETCLIP('BBS_maint')
CALL bbsALPHA.rexx SUBSTR(extension,2) arccom
RETURN


viewuser:
SAY
SAY bak2' 'name' 'def
DO i=1 TO 18
  stuff=data.i
  IF i=13 | i=14 THEN stuff=DATE(,data.i,'S')
  SAY RIGHT(i,2)||pen3 text.i||def':' stuff
END
CALL waiting()
RETURN


edituser:
IF getinput(1 1 'Change ['pen3'U'def']ser data or ['pen3'M'def']essage conference access (mU) > ')='M' THEN
  DO
    SAY
    SAY pen3'     - Message Conference Access -'def
    SAY '[O]ff turns all message conferences OFF.'
    SAY 'Set the last message read by you in ALL message conferences'
    temp=getinput(1 1 ' ['pen3'L'def']ast  ['pen3'F'def']irst  ['pen3'O'def']ff  ['pen3'Q'def']uit  (fLoq) > ')
    IF temp='Q' THEN RETURN
    SAY 'Resetting...'lineup
    data.22=''
    DO i=1 TO level
      IF temp='F' THEN num=0
      ELSE IF temp='O' THEN num=-1
      ELSE num=countcheck(bbspath'Numbers/LastMessage'i 0)
      data.22=data.22 num
    END
    CALL SetData()
    CALL sortconferences()
    CALL savedata(1)
    RETURN
  END
new=0
change=0
edata.=''
edname=name
DO i=0 TO data.0
  edata.i=data.i
END
num=1
DO WHILE num~='' | edname~=name
  IF num='' | LEFT(num,1)='Q' THEN
    DO
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
          change=0
        END
      IF new THEN
        DO
          data.=''
          DO i=0 TO edata.0
            data.i=edata.i
          END
          name=edname
          new=0
        END
      CALL SetData()
    END
  maxnum=10
  IF edata.20>sysoplevel THEN maxnum=20
  IF edata.20=99 THEN maxnum=24
  SAY bak2' 'name' 'def
  maxlines=21
  IF maxnum=10 THEN maxlines=20
  DO i=1 TO maxlines
    IF i=5 & name~=edname & edata.20<99 THEN ITERATE
    SAY RIGHT(i,2)||pen3 text.i||def':' data.i
  END
  IF edata.20>sysoplevel THEN
    DO
      line=LEFT(' ',50)
      IF name=edname THEN line=line'NEW = Change User.'
      line=pen3||line||def||lineup
      SAY line
    END
  num=getinput(1 0 'Select Line Number To Edit: ')
  IF num='NEW' & edata.20>sysoplevel & edname=name THEN    /* select a new user */
    DO
      new=1
      IF change THEN
        DO
          CALL SetData()
          CALL saveData(1)
        END
      change=0
      nufile=bbspath'Lists/NEW_USERS'
      IF EXISTS(nufile) THEN
        IF ~readlines(nufile 1) THEN CALL seelines(0)
      savename=name
      name=getinput(1 0 'New User Name: 'def)
      name=SPACE(name,1,'_')
      name=COMPRESS(name,':/*#?^')
      IF loadData()=0 THEN name=savename
      IF data.20>=edata.20 THEN
        DO
          SAY 'Can''t Edit!' pen3||name def'has an equal or higher level than thee.'
          name=savename
          CALL loadData()
        END
    END
  ELSE IF DATATYPE(num,'W') & num>0 THEN
    DO
      IF num>maxnum THEN
        DO
          SAY
          SAY pen3'You are not authorized to change that information!'def
          SAY
        END
      ELSE
        DO dummy=1 TO 1
          IF num=8 THEN
            DO
              SAY
              SAY 'Use spaces to seperate options.'
              SAY 'If the option word is in line 8, it is ON.'
              SAY 'Valid Options:'
              SAY '        MENU   combines all main commands into 1 menu.'
              SAY '        MENUS  splits main commands into 3 menus.'
              SAY '        COLOR  turns ANSI color codes ON.'
              SAY '        PHONE  makes your phone number public.'
              SAY '        QUICK  for long distance callers. See BBBBS.REVISION'
              SAY '        STREET makes your street address public.'
              SAY '        TERSE  skips some of the logon procedures.'
              SAY
            END
          line=RIGHT(num,2)||pen3 text.num||def': '
          SAY line||data.num
          temp=getinput(0 0 line)
          IF temp='' THEN
            DO
              IF num=1 | num=4 | num=5 | num=6 | num=7 THEN LEAVE dummy
              IF num=11 | num=12 | num=13 | num=20 THEN LEAVE dummy
            END
          IF num=5 | num=8 THEN temp=UPPER(temp)
          IF num=20 & DATATYPE(temp,'W') & temp>=edata.20 THEN
            temp=data.20
          IF edata.20>sysoplevel & name~=edname THEN line2=name' '
          ELSE line2=''
          IF num=21 & name=edname & edata.20<99 THEN LEAVE dummy
          line=text.num':' data.num pen6'CHANGED TO'def temp
          data.num=temp
          SAY line
          SAY
          change=1
        END
    END
END
IF change THEN
  DO
    CALL SetData()
    CALL saveData(1)
  END
RETURN


getnumber:
PARSE ARG tprompt
tnum=getinput(1 0 '  'tprompt' > ')
mask=COMPRESS(XRANGE(),'0123456789')
tnum=COMPRESS(tnum,mask)
IF ~DATATYPE(tnum,'W') THEN tnum=0
tnum=tnum%1
IF tnum>0 & tnum<10 THEN tnum='0'tnum
RETURN tnum


getbirth:
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  Birthday:'
SAY pen3'Please enter your birthday.'def
month=getnumber('month: (1-12)')
day=getnumber('  day: (1-31)')
year=getnumber(' year:       ')
IF year<100 THEN year=year+1900
born=year||month||day
IF born<18750101 | born>(DATE('S')-50000) THEN
  DO
    born=''
    IF getinput(1 1 'Would you rather skip this question? (Ny) > ')~='Y' THEN
      CALL getbirth()
  END
data.12=WORD(data.12,1)'  'WORD(data.12,2)'  'WORD(data.12,3)' 'WORD(born,1)
RETURN


getname:
CALL showuserlist()
SAY
pline='Please enter your full Email name : '
name=getinput(1 0 pline)
IF name='' THEN
  DO
    SAY 'No name, no entry.  Bye!'
    SIGNAL DONE
  END
name=cleanstring(1':'name)
name=COMPRESS(name,':/*#?^')
IF FIND(userlist,name)>0 | FIND(exclusion,name)>0 THEN
  DO
    SAY 'Sorry! That name is taken. Please try again.'
    RETURN 1
  END
RETURN 0


/** see if name is in data */

checkUser:
tries=0
IF name='NEW' THEN
  DO
    name=''
    DO WHILE getname()
    END
  END
IF FIND(userlist,name)=0 THEN
  DO
    IF EXISTS(bbspath'BBS_TEXT/NEW') THEN
      DO
        nonstop=0
        CALL readlines(bbspath'BBS_TEXT/NEW' 1)
        CALL seelines(0)
        CALL waiting()
      END
    SAY
    defile=bbspath'BBS_TEXT/DEF.NEW_USER'
    CALL loadcourtesy()
    wordnum=FIND(courtesy,name)
    IF wordnum>0 THEN
      DO
        SAY name', is on the Courtesy List. You will be granted immediate access.'
        courtesy=STRIP(DELWORD(courtesy,wordnum,1))
        IF writeopen(bbspath'Lists/Courtesy') THEN
          DO
            DO i=1 TO WORDS(courtesy)
              CALL WRITELN(f,WORD(courtesy,i))
            END
            CALL CLOSE(f)
          END
        defile=bbspath'BBS_TEXT/DEF.COURTESY'
      END
    ELSE IF bbsprefs.7=0 THEN SAY name', You have new user access.'
    IF readlines(defile 1) THEN SIGNAL DONE
    data.=''
    data.0=24
    DO i=6 TO 22
      data.i=lynes.i
    END
    data.12=DATE('S')'  'TIME('C')
    data.13=data.12
    lastondate=DATE('I')-1
    lastontime=TIME('C')
    SAY 'Please enter the password you would like to use here.'
    data.5=getinput(1 0 'Password: ')
    IF data.5='' THEN
      DO
        line=''name 'refused to enter a password.'
        SIGNAL DONE
      END
    data.1=''
    DO WHILE data.1=''
      data.1=getinput(0 0 'Full Name: ')
      IF data.1='' THEN SAY 'You MUST leave your real name!'
    END
    data.2=getinput(0 0 'Street: ')
    data.3=getinput(0 0 'City, State Zip: ')
    data.4=''
    DO WHILE data.4=''
      data.4=getinput(0 0 'Phone: ')
      IF data.4='' THEN
        SAY sysop 'MUST be able to reach you by phone to validate you!'
    END
    CALL getbirth()
    IF bbsprefs.8 THEN
      DO
        newufile=bbspath'Lists/NEW_USERS'
        IF EXISTS(newufile) THEN ok=OPEN(f,newufile,'A')
        ELSE
          DO
            ok=OPEN(f,newufile,'W')
            IF ok~=0 THEN CALL WRITELN(f,'*** New Users ***')
          END
        IF ok~=0 THEN
          DO
            temp=RIGHT(TIME('C'),7) COMPRESS(DATE())
            temp=temp LEFT(name,24)'=' data.1 data.4
            CALL WRITELN(f,temp)
          END
        CALL CLOSE(f)
      END
    data.9=getinput(0 0 'Computer: ')
    data.10=getinput(0 0 'Interests: ')
    test=getinput(1 1 pen3'Do you want other users to see your STREET address? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'STREET'
    test=getinput(1 1 pen3'Do you want other users to see your PHONE number? (Ny) > 'def)
    IF test='Y' THEN data.8=data.8 'PHONE'
    IF bbsprefs.7>0 THEN
      DO
        data.20=bbsprefs.7
        data.11='60 minutes' bbsprefs.16-1 'more times today'
      END
    SAY
    CALL SetData()
    IF data.20=0 THEN
      SAY 'Thank you, the sysop will give you higher access soon.'
    ELSE IF bbsprefs.25=1 THEN
      DO
        data.22=''
        data.23=''
        SAY
        SAY 'Setting message counters to last 10 messages in each conference...'
        DO i=1 TO level
          num=countcheck(bbspath'Numbers/LastMessage'i 0)-10
          IF num<0 | msg.i.0<10 THEN num=0
          lastread.i=num
          data.22=data.22 num
          data.23=data.23 0
        END
        SAY 'Setting file counter to last file uploaded...'
        lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
        newfilesdate='19900101 00:00:00'
      END
    SAY
    SAY 'Please feel free to leave additional info by using [C]omment.'
    SAY
    CALL saveData(1)
    SAY 'Adding' name 'to the user list...'
    newpassword=data.5
    sortuserflag=1
    temp=countcheck(bbspath'Numbers/Users' 0)+1
    CALL countcheck(bbspath'Numbers/Users' temp)
    CALL DELETE(bbspath'Lists/USERS')
  END
ELSE
  DO
    IF loadData()=0 THEN SIGNAL DONE
    PARSE VAR data.11 amins . atimes .
    lastondate=DATE('I',WORD(data.13,1),'S')
    lastontime=WORD(data.13,2)
    IF DATE('I')>lastondate | level>=sysoplevel THEN atimes=bbsprefs.16
    IF level=99 THEN amins=120
    data.13=DATE('S')'  'TIME()
    data.11=amins 'minutes' atimes-1 'more times today'
    passprompt='Enter Password: '
    DO tries=1 TO 3
      OPTIONS PROMPT passprompt
      PULL newpassword
      SAY ''
      IF(password=newpassword) THEN LEAVE tries; /* correct password */
      IF tries=3 THEN
        DO
          SAY
          SAY 'Access terminated.'
          line='*** Bad password ***' newpassword '***'
          SAY line
          SIGNAL OUT2
        END
      SAY lineup'                                 '
      passprompt='Incorrect.  Password: ' /* ask again */
    END
  END
CALL DELAY(14)
SAY
RETURN


saveData:
ARG messflag .
IF data.5='' THEN RETURN
SAY 'Updating...             'lineup
IF newfilesdate~='' THEN data.16=lastbrowse newfilesdate
ELSE IF lastbrowse>0 THEN
  DO
    IF WORDS(data.16)>1 THEN data.16=DELWORD(data.16,1,1)
    ELSE data.16=DATE('S') TIME()
    data.16=lastbrowse data.16
  END
IF messflag THEN
  DO
    userexclude.=0
    DO si=1 TO WORDS(data.22)
      IF WORD(data.22,si)=-1 THEN userexclude.si=1
    END
    data.22=''
    data.23=''
    DO si=1 TO 99
      IF ~DATATYPE(lastread.si,'W') THEN lastread.si=0
      IF userexclude.si THEN data.22=data.22 '-1'
      ELSE data.22=data.22 lastread.si
      IF ~DATATYPE(totwrit.si,'W') THEN totwrit.si=0
      data.23=data.23 totwrit.si
    END
  END
IF writeopen(bbspath'USERS/'name)=0 THEN RETURN
IF data.0<27 THEN data.0=27
DO i=1 TO data.0
  CALL WRITELN(f,data.i)
END
CALL CLOSE(f)
SAY 'User' name 'has been updated.'
RETURN


loadData:
IF name='' THEN RETURN 0
IF ~readopen(bbspath'USERS/'name) THEN RETURN 0
data.=''
DO i=1
  line=READLN(f)
  IF EOF(f) THEN BREAK
  data.i=line
END
data.0=i-1
CALL CLOSE(f)
winnings=WORD(data.18,1)
IF ~DATATYPE(winnings,'N') THEN winnings=0

setData:
IF WORDS(data.16)<3 THEN data.16='0 19900101 00:00:00'
lastbrowse=WORD(data.16,1)
IF ~DATATYPE(lastbrowse,'W') THEN lastbrowse=0
level=data.20
DO i=1 TO level
  lastread.i=WORD(data.22,i)
  IF ~DATATYPE(lastread.i,'W') THEN lastread.i=0
  totwrit.i=WORD(data.23,i)
  IF ~DATATYPE(totwrit.i,'W') THEN totwrit.i=0
END
password=data.5
IF ~DATATYPE(data.7,'W') THEN data.7=20
IF data.7<5 THEN data.7=5
IF FIND(UPPER(data.8),'TERSE')>0 THEN terseflag=1
ELSE terseflag=0
IF FIND(UPPER(data.8),'COLOR')>0 THEN colorflag=1
ELSE colorflag=0
CALL colors(colorflag)
menu='ALL'
IF FIND(UPPER(data.8),'MENUS')>0 THEN
  DO
    menuflag=1
    menu='MAIN'
  END
ELSE IF FIND(UPPER(data.8),'MENU')>0 THEN menuflag=1
ELSE menuflag=0
IF level=0 THEN menu='NEW'
data.21=UPPER(data.21)
maxtime=WORD(data.11,1)*60

loadFriends:
CALL MAKEDIR(bbspath'Friends')
alias.=''
alias.0=0
realname.=''
CALL CLOSE(f)
IF OPEN(f,bbspath'Friends/'name,'R')=0 THEN RETURN 1
DO i=1
  line=READLN(f)
  IF EOF(f) THEN LEAVE i
  alias.i=WORD(line,1)
  realname.i=WORD(line,2)
END
alias.0=i-1
CALL CLOSE(f)
RETURN 1


switchmenuflag:
IF menuflag=1 THEN
  DO
    menuflag=0
    noff='OFF'
  END
ELSE
  DO
    menuflag=1
    noff='ON'
  END
SAY 'Menus turned' pen3||noff||def'.'
SAY 'To make a permanent change, add or delete MENU(S) from [Y]our userdata item 8.'
RETURN


switchcolors:
IF colorflag=1 THEN
  DO
    colorflag=0
    noff='OFF'
  END
ELSE
  DO
    colorflag=1
    noff='ON'
  END
CALL colors(colorflag)
SAY 'Color turned' pen3||noff||def'.'
SAY 'To make a permanent change, add or delete COLOR from [Y]our userdata item 8.'
RETURN


/* ANSI pen color codes */
colors:
ARG onoff
IF onoff THEN
  DO
    lineup='1B'x'M'
    def='';  /* default */
    pen0='';  pen1='';  pen2='';  pen3=''
    pen4='';  pen5='';  pen6='';  pen7=''
    bak0='';  bak1='';  bak2='';  bak3=''
    bak4='';  bak5='';  bak6='';  bak7=''
  END
ELSE
  DO
    pen0=''; pen1=''; pen2=''; pen3=''; pen4=''; pen5=''; pen6=''; pen7=''
    bak0=''; bak1=''; bak2=''; bak3=''; bak4=''; bak5=''; bak6=''; bak7=''
    def='';  lineup=''
  END
RETURN


sortinfofiles:
infolist=SHOWDIR(bbspath'Information')
IF infolist='' THEN
  DO
    SAY
    SAY pen3'No files are currently in the Information drawer.'def
    SAY
    RETURN 1
  END
IF ~DATATYPE(sortinfo.0,'W') THEN
  DO
    info.=''
    sortinfo.=''
    info.0=WORDS(infolist)
    DO i=1 TO info.0
      info.i=WORD(infolist,i)
    END
    SAY 'Sorting..'
    CALL QSORT(1,info.0,info)
    sortinfo.0=info.0%3
    IF (info.0//3)>0 THEN sortinfo.0=sortinfo.0+1
    DO i=1 TO sortinfo.0
      sortinfo.i=''
      DO j=0 TO 2
        k=i+j*sortinfo.0
        IF k<=info.0 THEN
          DO
            sortinfo.i=sortinfo.i RIGHT(k,3)'.' LEFT(info.k,19)
            infocount=WORD(STATEF(bbspath'Information/'info.k),8)
            sortinfo.i.0=sortinfo.i.0||RIGHT(infocount,5) LEFT(info.k,19)
          END
      END
    END
    SAY lineup'         'lineup
  END
RETURN 0


information:
IF sortinfofiles() THEN RETURN
SAY pen3'These text files are available for reading online...'def
num=1
readcount=-1
DO infoloop=1
  IF num=0 THEN
    DO
      IF readcount~=-1 THEN
        DO
          sortinfo.0=''
          IF sortinfofiles() THEN RETURN
        END
      SAY CENTER('- Number of accesses per file -',75)
    END
  SAY pen3||LEFT('-',75,'-')||def
  DO i=1 TO sortinfo.0
    IF num=0 THEN SAY sortinfo.i.0
    ELSE SAY sortinfo.i
  END
  IF num=0 THEN
    DO
      CALL waiting()
      num=1
      ITERATE infoloop
    END
  num=getinput(1 0 pen3'Select Number Of Information File To View. 0=Stats > 'def)
  IF num=0 THEN ITERATE infoloop
  IF ~DATATYPE(num,'W') | num<1 | num>info.0 THEN RETURN
  readcount=STATEF(bbspath'Information/'info.num)
  readbytes=WORD(readcount,2)
  readcount=WORD(readcount,8)
  IF ~DATATYPE(readcount,'W') THEN readcount=0
  SAY '  'info.num 'is' readbytes 'bytes.'
  SAY 'Loading File...'
  ADDRESS COMMAND 'C:filenote' bbspath'Information/'info.num readcount+1
  CALL readlines(bbspath'Information/'info.num 1)
  CALL cleanline(0)
  SAY '    'lynes.0 'lines.'
  CALL seelines(0)
  IF waitchar~='Q' THEN CALL waiting()
  nonstop=0
END
RETURN


newfiles:
SAY
test=''
test=getinput(1 1 'Show one library only? (Ny) > ')
IF test='Y' THEN
  IF chdir()>0 THEN RETURN
SAY 'Searching for new (un-browsed) files since' DATE(,WORD(data.16,2),'S') 'at' WORD(data.16,3)'...'
lastbrowz=WORD(data.16,1)
lastfileup=countcheck(bbspath'Numbers/LastFile' 0)

newfiles2:
IF lastbrowz>=lastfileup THEN
  DO
    lastbrowz=0
    SAY pen3'No new files. Listing backwards by date from last file uploaded...'def
  END
ELSE newfilesflag=1
j=0
IF test='Y' THEN
  DO
    filecount=WORDS(SHOWDIR(bbspath'FileNotes/'plaindir))
    CALL busywait(4 1)
  END
DO ni=lastfileup TO lastbrowz+1 BY -1
  IF files.ni~='' THEN
    DO
      IF test='Y' THEN
        DO
          IF ni>1 THEN CALL busywait(60 ni lastfileup-lastbrowz)
          IF j>=filecount THEN LEAVE ni
          IF UPPER(LEFT(WORD(files.ni,1),12))~=UPPER(LEFT(plaindir,12)) THEN
            ITERATE ni
        END
      jj=files.ni.0
      IF WORD(alpha.jj,4)>level | FIND(data.21,UPPER(WORD(files.ni,1)))>0 THEN
        ITERATE ni  /* unauthorized */
      IF test='Y' THEN CALL busywait(4 0)
      j=j+1
      IF j=1 THEN CALL fileheader()
      SAY LEFT(alpha.jj,76)
      IF (j+2)//(linesperpage-1)=0 THEN
        IF waiting2() THEN LEAVE ni
      IF test='Y' THEN CALL busywait(4 1)
    END
END
IF test='Y' THEN CALL busywait(4 0)
IF j//linesperpage~=0 THEN CALL waiting()
IF j=0 & newfilesflag=1 THEN
  DO
    lastbrowz=999999
    newfilesflag=0
    CALL newfiles2()
  END
IF test~='Y' THEN
  DO
    CALL newinfo()
    IF lynes.0>0 THEN CALL waiting()
  END
nonstop=0
RETURN


newinfo:
lynes.=''
lynes.0=0
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
startline=1
arg=bbspath'Information'
IF WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:locdirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:locdirlist'),2)>3 THEN
      DO
        lynes.startline=pen1||bak2' New or Updated Information Files. Enter'def pen3'I'def bak2'from the main menu to read 'def
        CALL readlines('ram:locdirlist' startline+1)
      END
  END
arg=bbspath'Profiles'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    ADDRESS COMMAND 'C:LIST >ram:locdirlist' arg 'NOHEAD DATES SINCE' sincedate
    IF WORD(STATEF('ram:locdirlist'),2)>3 THEN
      DO
        startline=lynes.0+2
        lynes.startline=pen1||bak2' New or Updated User Profiles. Enter'def pen3'&'def bak2'from the main menu to read 'def
        CALL readlines('ram:locdirlist' startline+1)
      END
  END
arg=bbspath'rexxDoors/Data/Polls'
IF level>0 & WORD(STATEF(arg),5)>lastondate THEN
  DO
    startline=lynes.0+2
    lynes.startline=pen1||bak2' Voting Activity. Enter'def pen3'J'def bak2'from the main menu, then select Polling_Place 'def
    lynes.0=startline
  END
IF logonflag=1 THEN nonstop=1
IF lynes.0>0 THEN CALL seelines(1)
nonstop=0
RETURN


areaselect:
SAY pen3||LEFT('-',75,'-')||def
DO i=1 TO msgs.0
  SAY msgs.i
  IF i//linesperpage=0 THEN CALL waiting()
END
temp=getinput(1 0 pen3'Select Message Conference: 'def)
IF ~DATATYPE(temp,'W') | temp<1 | temp>level | FIND(data.21,temp)>0 THEN RETURN 1
msgdir=temp
RETURN 0


chdir:
string=''
SAY pen3||LEFT('-',75,'-')||def
DO i=1 TO libs.0
  SAY libs.i
END
dirnum=getinput(1 0 pen3'Select Library Number: 'def)
IF ~DATATYPE(dirnum,'W') THEN
  DO
    waitchar=dirnum
    RETURN 2
  END

chdir2:
IF dirnum<1 | dirnum>99 THEN
  DO
    waitchar=dirnum
    RETURN 1
  END
IF dirs.dirnum='' THEN
  DO
    SAY pen3'That library number is currently un-assigned.'def
    RETURN 1
  END
IF dirnum>level | FIND(data.21,UPPER(dirs.dirnum))>0 THEN
  DO
    SAY pen3'You do not have authorization for that library!'def
    RETURN 1
  END
CALL MAKEDIR(libpath||dirs.dirnum)
CALL setdir(libpath||dirs.dirnum)
t=libpath||plaindir'.txt'
IF ~EXISTS(t) THEN RETURN 0
nonstop=1
SAY
CALL readlines(t 1)
CALL seelines(1)
SAY
nonstop=0
RETURN 0


since:
dm=DATE(,WORD(data.16,2),'S')
SAY
SAY 'New files or files moved since' dm
CALL listsince()
CALL readlines('ram:locdirlist' 1)
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


listsince:
dm=DATE(,WORD(data.16,2),'S')
PARSE VAR dm da' 'mo' 'yr .
yr=RIGHT(yr,2)
sincedate=da'-'mo'-'yr
ADDRESS COMMAND 'C:list >ram:locdirlist' directory 'DATES SINCE' sincedate
RETURN


list:
onetime=0
IF DATATYPE(arg,'W') THEN onetime=1
ELSE arg=''
DO listloop=1
  IF DATATYPE(arg,'W') THEN
    DO
      dirnum=arg
      arg=''
      IF chdir2()>0 THEN RETURN
      CALL listsimple()
      IF waitchar='Q' | onetime THEN LEAVE listloop
    END
  ELSE IF arg='' THEN
    DO
      IF chdir()>0 THEN RETURN
      test='Y'
      CALL showalpha2()
      arg=''
      IF waitchar='Q' THEN waitchar=''
      IF waitchar~='' THEN RETURN
      ITERATE listloop
    END
  ELSE RETURN
END
RETURN


listsimple:
ADDRESS COMMAND 'C:list >ram:locdirlist' directory 'DATES'
IF readlines('ram:locdirlist' 1) THEN RETURN
IF lynes.0>3 THEN
  DO
    SAY pen3'Sorting...'def||lineup
    linesave=lynes.1  /* these 4 lines put in to leave dir title at top */
    lynes.1='0'
    CALL QSORT(1,lynes.0-1,lynes)
    CALL DELAY(14)
    lynes.1=linesave
  END
CALL seelines(1)
nonstop=0
CALL waiting()
RETURN


browse:
curdironly=0
brdir=PRAGMA('D')
brfilenum=1
nonstop=0
IF files.0<1 THEN RETURN
lastfilenum=countcheck(bbspath'Numbers/LastFile' 0)
IF lastfilenum<1 THEN RETURN
onearg=0
IF arg='' THEN
  DO
    lin='Browsing'
    test=getinput(1 1 'Browse one library only? (Ny) > ')
    IF test='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        lin=lin 'the' pen3||plaindir||def 'library'
        t=libpath||plaindir'.txt'
        IF level>sysoplevel THEN
          IF getinput(1 1 'Edit the'pen3 Plaindir def'library info file? (Ny) > ')='Y' THEN
            DO
              IF ~EXISTS(t) THEN
                DO
                  IF writeopen(t)~=0 THEN
                    DO
                      CALL WRITELN(f,TRIM(CENTER('***' plaindir '***',77)))
                      CALL WRITELN(f,LEFT('',75,'='))
                      CALL CLOSE(f)
                      CALL DELAY(28)
                    END
                END
              CALL bbsED(1 t)
              RETURN
            END
      END
    ELSE lin=lin 'all file libraries'
    lin=lin 'backwards from latest file.'
    SAY lin
    SAY
  END
ELSE onearg=1
i=0
IF arg='' | UPPER(arg)='NEW' | UPPER(arg)='ALL' THEN
  DO lastfileloop=1
    IF lastfilenum<1 THEN RETURN
    arg=WORD(files.lastfilenum,2)
    brfilenum=lastfilenum
    IF WORD(files.lastfilenum,2)~='' THEN LEAVE lastfileloop
    lastfilenum=lastfilenum-1
  END
ELSE IF DATATYPE(arg,'W') & files.arg~='' THEN
  DO
    brfilenum=arg
    arg=WORD(files.arg,2)
    IF arg='' THEN
      DO
        SAY 'File number' brfilenum 'does not exist in the current libraries!'
        RETURN
      END
  END
ELSE
  DO
    IF onearg THEN CALL busywait(4 1)
    DO ni=lastfilenum TO 1 BY -1
      IF onearg THEN CALL busywait(60 ni lastfilenum)
      IF UPPER(WORD(files.ni,2))~=UPPER(arg) THEN ITERATE ni
      brfilenum=ni
      CALL busywait(4 0)
      LEAVE ni
    END
    IF ni<1 THEN
      DO
        SAY 'Unable to find a file description for' pen3||arg||def'.'
        RETURN
      END
  END
IF ~curdironly THEN CALL setdir(libpath||WORD(files.brfilenum,1))
savearg=arg
IF brfilenum>lastfilenum THEN brfilenum=lastfilenum
newfilesdate=DATE('S') TIME()
DO browseloop=1
  IF curdironly THEN CALL busywait(4 1)
  DO ni=brfilenum TO 0 BY -1
    IF ni=0 THEN LEAVE browseloop
    IF files.ni='' THEN ITERATE ni
    IF onearg THEN
      DO
        CALL busywait(60 ni lastfilenum)
        IF UPPER(arg)=UPPER(WORD(files.ni,2)) THEN LEAVE ni
        ELSE ITERATE ni
      END
    testdir=UPPER(WORD(files.ni,1))
    IF curdironly & UPPER(plaindir)~=UPPER(testdir) THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        IF ni>0 THEN CALL busywait(60 ni lastfilenum)
        ITERATE ni
      END
    IF FIND(data.21,testdir)>0 | finddirnum(testdir)>level THEN
      DO
        IF ni>lastbrowse THEN lastbrowse=ni
        ITERATE ni
      END
    LEAVE ni
  END
  IF curdironly | onearg THEN CALL busywait(4 0)
  onearg=0
  IF ni=0 THEN brfilenum=lastbrowse
  ELSE brfilenum=ni
  argname=WORD(files.brfilenum,2)
  IF argname='' THEN RETURN
  CALL setdir(libpath||WORD(files.brfilenum,1))
  arg=bbspath'FileNotes/'plaindir'/'argname
  CALL readlines(arg 1)
  IF nonstop=1 THEN brostop=1
  ELSE brostop=0
  CALL seelines(1)
  IF brfilenum>lastbrowse THEN lastbrowse=brfilenum
  IF brostop THEN
    DO
      SAY
      nonstop=1
      brfilenum=brfilenum-1
    END
  ELSE
    DO
      line=''
      endtest=UPPER(RIGHT(argname,4))
      IF FIND('.ARC .ARJ .DMS .LZH .LHA .RUN .ZIP .ZOO',endtest)>0 THEN
        line='['pen3'C'def']ontents ['pen3'D'def']ownload'
      ELSE line='['pen3'D'def']ownload'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'E'def']dit'
      IF level>sysoplevel | name=WORD(lynes.3,2) THEN
        line=line '['pen3'K'def']ill'
      IF level>sysoplevel THEN line=line '['pen3'L'def']ib'
      line=line '['pen3'M'def']ark ['pen3'N'def']on-Stop'
      IF endtest='.TXT' THEN line=line '['pen3'R'def']ead'
      line=line '['pen3'Q'def']uit ['pen3'?'def'] > '
      brcom=getinput(1 0 line)
      IF DATATYPE(brcom,'W') THEN
        DO
          brfilenum=brcom+1
          IF brfilenum>lastfilenum THEN brfilenum=lastfilenum+1
          IF brfilenum<1 THEN brfilenum=1
          SAY
        END
      ELSE brcom=LEFT(brcom,1)
      CALL cleanline(0)
      IF brcom='Q' THEN LEAVE browseloop
      IF brcom='M' THEN
        DO
          wordnum=FIND(data.25,brfilenum)
          IF wordnum=0 THEN
            DO
              data.25=STRIP(data.25 brfilenum)
              SAY lineup||argname 'marked for next download.'
              SAY
            END
          ELSE
            DO
              data.25=STRIP(DELWORD(data.25,wordnum,1))
              SAY argname 'removed from download list.'
            END
        END
      IF brcom='H' | brcom='?' THEN
        DO
          SAY pen3' - HELP with the Browse Files commands -'def
          SAY ' RETURN reads the next file description in line.'
          SAY ' 34 will display the description of file number 34, if it exists.'
          SAY ' C  displays the contents of an archived (arc dms lzh lha zip zoo) file.'
          SAY ' D  displays the download menu.'
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
          SAY ' E  puts this file description into the online Editor.'
          SAY ' K  deletes a file you uploaded. you cannot Kill others!'
            END
          IF level>sysoplevel THEN
          SAY ' L  move file and description to new Library and/or rename.'
          SAY ' M  mark/unmark the current file for the next download'
          SAY ' N  displays all descriptions without pausing. CTRL-E to Exit!'
          SAY ' R  displays file as text. - ONLY FILES THAT END IN .TXT -'
          SAY ' Q  returns to the main menu(s). (Quit)'
          SAY
          CALL waiting()
          IF waitchar='Q' THEN LEAVE browseloop
        END
      ELSE IF brcom='L' & level>sysoplevel THEN
        DO
          curdir=PRAGMA('D')
          IF getinput(1 1 'Rename' argname '? (Ny) > ')='Y' THEN
            DO
              newarg=getinput(0 0 'Rename' argname 'to ')
              IF newarg~='' THEN
                DO
                  IF is_here(newarg) THEN ITERATE browseloop
                  IF wi=999999 THEN ITERATE browseloop
                  IF EXISTS(libpath||filedir'/'newarg) THEN
                    DO
                      SAY
                      SAY '***' newarg 'already exists!'
                      SAY
                      ITERATE browseloop
                    END
                  junk=getinput(1 1 'Are you SURE you want to rename' argname 'to' newarg'? (Ny) ')
                  IF junk='Y' THEN
                    DO
                      lynes.2=OVERLAY(newarg,lynes.2,7,25)
                      comment=WORD(STATEF(arg),8)
                      CALL DELETE(arg)
                      arg=bbspath'FileNotes/'plaindir'/'newarg
                      CALL savelines(arg)
                      IF comment='' THEN
                        DO
                          mpath=libpath||plaindir
                          IF RENAME(mpath'/'argname,mpath'/'newarg)=0 THEN
                            SAY 'Rename failed on main file!'
                        END
                      ELSE
                        DO
                          t=LASTPOS('/',comment)
                          IF t=0 THEN t=LASTPOS(':',comment)
                          mpath=LEFT(comment,t-1)
                          IF RENAME(comment,mpath'/'newarg)=1 THEN
                            ADDRESS COMMAND 'C:FileNote' arg mpath'/'newarg
                          ELSE SAY 'Rename failed on external file!'
                        END
                      files.brfilenum=STRIP(WORD(files.brfilenum,1)) newarg
                      anum=files.brfilenum.0
                      alpha.anum=OVERLAY(newarg,alpha.anum,1,WORDINDEX(alpha.anum,2)-2)
                      argname=newarg
                      sortalphaflag=1
                      savefileflag=1
                    END
                END
            END
          mvdir=getinput(0 0 'Move' argname 'to Library (name|number) ')
          IF mvdir~='' THEN
            DO
              IF DATATYPE(mvdir,'W') THEN
                DO
                  dirnum=mvdir
                  IF UPPER(dirs.dirnum)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      IF chdir2()=0 THEN
                        DO
                          CALL readlines(arg 1)
                          CALL movefile(brfilenum dirs.dirnum)
                        END
                    END
                END
              ELSE
                DO
                  mvdir=STRIP(mvdir)
                  IF UPPER(mvdir)~=UPPER(WORD(files.brfilenum,1)) THEN
                    DO
                      DO mj=1 TO level+1
                        IF UPPER(mvdir)=UPPER(dirs.mj) THEN LEAVE mj
                      END
                      IF mj<=level THEN CALL movefile(brfilenum mvdir)
                    END
                END
            END
          IF savefileflag>0 THEN CALL savefilelist()
          CALL setdir(curdir)
        END
      ELSE IF brcom='N' THEN
        DO
          brfilenum=brfilenum-1
          nonstop=1
          SAY pen3'To EXIT non-stop scrolling of text, press CTRL-E'def
          SAY
          CALL DELAY(100)
          brcom=''
        END
      ELSE IF brcom='C' THEN
        DO
          temp=STRIP(WORD(STATEF(arg),8))
          IF temp='' THEN temp=libpath||plaindir'/'argname
          CALL Contents.rexx(temp)
          IF EXISTS('RAM:CONTENTS') THEN
            DO
              CALL readlines('RAM:CONTENTS' 1)
              CALL seelines(0)
              IF waitchar~='Q' THEN CALL waiting()
              nonstop=0
            END
          ELSE SAY pen3'Not an archived file.'def
        END
      ELSE IF brcom='D' THEN
        DO
          arg2=arg
          arg=brfilenum
          CALL dload()
          arg=arg2
        END
      ELSE IF brcom='E' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              firstedit=5
              IF level>sysoplevel THEN firstedit=1
              CALL bbsED(firstedit arg)
            END
        END
      ELSE IF brcom='K' THEN
        DO
          IF level>sysoplevel | name=WORD(lynes.3,2) THEN
            DO
              IF getinput(1 1 pen3'Do you really want to kill this file? (nY) >'def)~='N' THEN
                DO
                  tempnum=WORD(lynes.1,2)
                  IF tempnum=lastfilenum THEN
                    DO
                      CALL DELETE(bbspath'Numbers/LastFile')
                      CALL DELAY(28)
                      lastfilenum=lastfilenum-1
                      CALL countcheck(bbspath'Numbers/LastFile' lastfilenum)
                    END
                  files.tempnum=''
                  tempnum2=files.tempnum.0
                  alpha.tempnum2='0 0' tempnum '100'
                  CALL savefilelist()
                  finfo=STATEF(arg)
                  IF WORDS(finfo)>7 THEN argname=WORD(finfo,8)
                  CALL DELETE(argname)
                  CALL DELETE(arg)
                  SAY argname pen3'has been deleted.'def
                END
            END
        END
      ELSE IF brcom='R' & endtest='.TXT' THEN
        DO
          vcount=WORD(lynes.2,7)+1
          lynes.2=STRIP(DELWORD(lynes.2,7,1)) vcount
          edtype=''
          CALL savelines(arg)
          CALL showtext(argname)
        END
      ELSE brfilenum=brfilenum-1
    END
END
CALL setdir(brdir)
waitchar=''
IF nonstop THEN CALL waiting()
nonstop=0
CALL savedata(0)
RETURN


movefile:
PARSE ARG fnum movdir .
fromdir=STRIP(WORD(files.fnum,1))
farg=STRIP(WORD(files.fnum,2))
CALL MAKEDIR(libpath||movdir)
ADDRESS COMMAND 'C:COPY' libpath||fromdir'/'farg libpath||movdir
IF EXISTS(libpath||movdir'/'farg) THEN CALL DELETE(libpath||fromdir'/'farg)
files.fnum=movdir farg
lynes.3=DELWORD(lynes.3,WORDS(lynes.3),1)
lynes.3=STRIP(lynes.3) movdir
CALL MAKEDIR(bbspath'FileNotes/'movdir)
CALL savelines(bbspath'FileNotes/'movdir'/'farg)
ndx=files.fnum.0
dnum=finddirnum(movdir)
alpha.ndx=OVERLAY(RIGHT(dnum,2) movdir,alpha.ndx,31,15)
IF EXISTS(bbspath'FileNotes/'movdir'/'farg) THEN
  DO
    temp=bbspath'FileNotes/'fromdir'/'farg
    comment=WORD(STATEF(temp),8)
    CALL DELETE(temp)
    IF comment~='' THEN
      ADDRESS COMMAND 'C:FileNote' bbspath'FileNotes/'movdir'/'farg comment
  END
savefileflag=1
line='Moved:' fromdir'/'farg 'to' movdir
SAY line
RETURN


textsearch:
PARSE ARG sfile' 'sarg
IF sarg='' THEN RETURN 0
x=OPEN(f,sfile,'R')
IF x=0 THEN RETURN 0
sarg=UPPER(sarg)
stemp=UPPER(READCH(f,65000))
CALL CLOSE(f)
retflag=0
IF POS(sarg,stemp)>0 THEN retflag=1
DROP stemp
RETURN retflag


bbsSEARCH:
smenu=menu
test=UPPER(LEFT(arg,1))
IF test='F' THEN smenu='FILE'
IF test='M' THEN smenu='MSG'
IF test='U' THEN smenu='MAIN'
IF smenu='ALL' THEN
  DO
    junk=getinput(1 1 'Search ['pen3'F'def']iles ['pen3'M'def']essages or ['pen3'U'def']sers (fmu) > ')
    IF junk='F' THEN smenu='FILE'
    ELSE IF junk='M' THEN smenu='MSG'
    ELSE IF junk='U' THEN smenu='MAIN'
    ELSE RETURN
  END
IF WORDS(arg)>1 THEN searcharg=UPPER(SUBSTR(arg,WORDINDEX(arg,2)))
ELSE searcharg=getinput(0 0 pen3'Search Phrase: 'def)
IF LENGTH(STRIP(searcharg))=0 THEN RETURN
searcharg=COMPRESS(searcharg,'*')
IF smenu='NEW' | smenu='MAIN' THEN
  DO
    SAY 'Searching Userlist...'
    DO i=1 TO WORDS(userlist)
      IF POS(UPPER(searcharg),UPPER(WORD(userlist,i)))>0 THEN
        SAY WORD(userlist,i)
    END
  END
IF smenu='MSG' THEN
  DO
    IF getinput(1 1 'Search one conference only? (Ny) > ')='Y' THEN
      DO
        IF areaselect() THEN RETURN
        SAY 'Searching' msg.msgdir 'Message Conference for'pen3 searcharg||def'...'
        SAY
        CALL searchmsgdir()
      END
    ELSE
      DO
        SAY 'Searching All Public Message Conferences for'pen3 searcharg||def'...'
        SAY
        DO i=1 TO level
          msgdir=i
          IF msg.msgdir='' | FIND(data.21,msgdir)>0 THEN ITERATE i
          CALL searchmsgdir()
          i=msgdir
          IF msgcom='Q' THEN i=999999
        END
      END
  END
IF smenu='FILE' THEN
  DO
    line=pen3'Searching'
    curdironly=0
    IF getinput(1 1 'Search one library only? (Ny) > ')='Y' THEN
      DO
        IF chdir()>0 THEN RETURN
        curdironly=1
        line=line 'the' pen3||plaindir||def 'library'
        SAY
      END
    ELSE
      DO
        line=line 'all file libraries'
        SAY
        SAY pen3'WARNING!'def 'Searching' RIGHT(files.0,5) '['pen3'F'def']ull descriptions may take'pen3 TRUNC(files.0/(114*cpu)+.05,1) def'minutes!'
      END
    test=getinput(1 1 '   ['pen3'A'def']lphaList search or ['pen3'F'def']ull descriptions? (Afq) > ')
    IF test='Q' THEN RETURN
    SAY
    SAY line 'for'def UPPER(searcharg)
    SAY pen3' - To ABORT, press CTRL-E -'def
    SAY
    IF test~='F' THEN
      DO
        CALL fileheader()
        DO i=1 TO alpha.0
          CALL busywait(60 i alpha.0)
          ii=WORD(alpha.i,4)
          IF ii>level THEN ITERATE i
          IF curdironly=1 & ii~=dirnum THEN ITERATE i
          ii=WORD(alpha.i,3)
          IF POS(UPPER(WORD(files.ii,1)),data.21)>0 THEN ITERATE i
          tempnum=POS(UPPER(searcharg),UPPER(alpha.i))
          IF tempnum>0 THEN
            DO
              CALL busywait(4 0)
              SAY alpha.i
              IF colorflag=1 THEN
                SAY pen3||LEFT(' ',tempnum-1)||lineup||UPPER(searcharg)||def
              CALL busywait(4 1)
            END
        END
      END
    ELSE
      DO
        cck=countcheck(bbspath'Numbers/LastFile' 0)
        nonstop=1
        DO i=1 TO cck
          iii=cck+1-i
          IF files.iii='' THEN ITERATE i
          ii=files.iii.0
          ii=WORD(alpha.ii,4)
          IF ii>level THEN ITERATE i
          IF curdironly=1 & ii~=dirnum THEN ITERATE i
          IF POS(UPPER(WORD(files.iii,1)),data.21)>0 THEN ITERATE i
          farg=WORD(files.iii,1)'/'WORD(files.iii,2)
          SAY '1B'x'M' RIGHT(farg,40) LEFT(iii,7)
          IF textsearch(bbspath'FileNotes/'farg searcharg) THEN
            DO
              savei=i
              CALL readlines(bbspath'FileNotes/'farg 1)
              CALL seelines(2)
              i=savei
              SAY
              SAY
            END
        END
      END
    CALL busywait(4 0)
  END
searcharg=''
nonstop=0
SAY
IF i<999999 THEN SAY 'All available items have been searched.'
SAY
CALL waiting()
RETURN


searchmsgdir:
msglist=SHOWDIR(msgpath||msgdir)
IF WORDS(msglist)>0 THEN SAY lineup||RIGHT(msg.msgdir,40)
qi=WORDS(msglist)
DO wi=1 TO qi
  CALL busywait(8 wi qi)
  messnum=WORD(msglist,wi)%1
  IF textsearch(msgpath||msgdir'/'messnum searcharg) THEN
    DO
      CALL busywait(4 0)
      savelast=lastread.msgdir
      CALL readmsg(0 messnum)
      lastread.msgdir=savelast
      IF msgcom='Q' THEN RETURN
      CALL busywait(4 1)
    END
END
CALL busywait(4 0)
RETURN


finddirnum:
ARG fdirname .
DO fdir=1 TO 99
  IF UPPER(dirs.fdir)=UPPER(fdirname) THEN RETURN fdir
END
RETURN 100


writebuffer:
PARSE ARG bufname .
CALL DELETE(bufname)
startnum=lynes.0+1
OPTIONS PROMPT ''
SAY pen3'LOCAL logon! Input cannot exceed 250 characters per line!'def
SAY 'Type 'pen3'/E'def 'or' pen3'/S'def' on a new line to exit and' pen3'DO YOUR OWN WORDWRAP!'def
DO bufloop=startnum
  PARSE PULL line
  IF LEFT(UPPER(STRIP(line)),2)='/E' | LEFT(UPPER(STRIP(line)),2)='/S' THEN
    LEAVE bufloop
  lynes.bufloop=line
END
lynes.0=bufloop-1
CALL wrapbuf(startnum)
CALL DELETE(bufname)     /* these 4 lines make wordwrap more consistent */
CALL savelines(bufname)
CALL readlines(bufname 1)
CALL wrapbuf(startnum)
RETURN


wrapbuf:
ARG startnum .
CALL cleanline(1)
SAY pen3'Wordwrapping...'def
lynes.startnum=TRANSLATE(lynes.startnum,' ','09'x)
lynes.startnum=COMPRESS(lynes.startnum,'0C'x)  /* no FF */
DO wi=startnum WHILE wi<=lynes.0
  wj=wi+1
  lynes.wj=COMPRESS(lynes.wj,'08'x||'0C'x||'7F'x)
  tabpos=POS('09'x,lynes.wi)
  DO WHILE tabpos>0
    lynes.wi=DELSTR(lynes.wi,tabpos,1)
    lynes.wi=INSERT('  ',lynes.wi,tabpos-1)
    tabpos=POS('09'x,lynes.wi)
  END
  IF LENGTH(lynes.wi)>75 THEN
    DO
      testchar=''
      IF lynes.wj~='' THEN testchar=LEFT(lynes.wj,1)
      IF testchar=' ' | testchar='.' | testchar=':' THEN
        DO
          DO wjj=lynes.0 TO wi+1 BY -1
            wk=wjj+1
            lynes.wk=lynes.wjj
          END
          lynes.wj=''
          lynes.0=lynes.0+1
        END
      DO wl=WORDS(lynes.wi) TO 1 BY -1 WHILE LENGTH(lynes.wi)>74
        IF WORDS(lynes.wi)=1 THEN
          lynes.wi=LEFT(lynes.wi,74) SUBSTR(lynes.wi,75)
        lynes.wj=WORD(lynes.wi,wl) lynes.wj
        lynes.wi=STRIP(DELWORD(lynes.wi,wl,1))
      END
    END
END
RETURN


seelines:
ARG fancy .
DO i=1 TO lynes.0
  IF fancy=0 THEN SAY lynes.i||def
  ELSE
    DO
      IF LEFT(lynes.i,2)=': ' & WORDS(lynes.i)=2 THEN ITERATE i
      ELSE IF LEFT(lynes.i,10)='Directory ' | LEFT(lynes.i,5)='=====' THEN
        SAY pen3||lynes.i||def
      ELSE SAY lynes.i
      IF fancy=2 & colorflag=1 & searcharg~='' THEN
        DO
          testpos=POS(UPPER(searcharg),UPPER(lynes.i))
          IF testpos>0 THEN
            SAY LEFT(' ',testpos-1)||pen3||lineup||UPPER(searcharg)||def
        END
    END
  IF i//linesperpage=0 THEN
    IF waiting2() THEN LEAVE i
END
nonstop=0
RETURN


readlines:
CALL CLOSE(f)
PARSE ARG tempname readstart .
IF ~readopen(tempname) THEN RETURN 1
IF readstart<2 THEN lynes.=''
DO ri=readstart
  line=READLN(f)
  IF EOF(f) THEN BREAK
  lynes.ri=line
END
lynes.0=ri-1
CALL CLOSE(f)
DO ri=lynes.0 TO 0 BY -1 WHILE LENGTH(lynes.ri)=0 | LEFT(UPPER(lynes.ri),2)='/E' | LEFT(UPPER(lynes.ri),2)='/S'
END
lynes.0=ri
RETURN 0


savelines:
PARSE ARG tempname .
IF EXISTS(tempname) & edtype='MAIL' THEN
  DO
    ok=OPEN(f,tempname,'A')
    IF ok~=0 THEN CALL WRITELN(f,LEFT('',74,'^'))
  END
ELSE ok=OPEN(f,tempname,'W')
IF ok=0 THEN
  DO
    line='***' tempname 'failed to open for saving!'
    SAY line
    RETURN 1
  END
DO wi=1 TO lynes.0
  CALL WRITELN(f,lynes.wi)
END
CALL CLOSE(f)
RETURN 0


loaduserlist:
userlist=SHOWDIR(bbspath'Users')
ulynes.=''
IF ~EXISTS(bbspath'Lists/USERS') THEN CALL sortuserlist()
ELSE IF readopen(bbspath'Lists/USERS') THEN
  DO
    SAY 'Loading Userlist...'
    DO lui=1
      line=READLN(f)
      IF EOF(f) THEN BREAK
      ulynes.lui=line
    END
    ulynes.0=lui-1
    CALL CLOSE(f)
  END
RETURN


saveuserlist:
SIGNAL OFF BREAK_E
IF writeopen(bbspath'Lists/USERS') THEN
  DO
    DO i=1 TO ulynes.0
      CALL WRITELN(f,ulynes.i)
    END
    CALL CLOSE(f)
  END
RETURN


sortuserlist:
SAY 'Rebuilding Userlist...'
sortuserflag=0
userlist=SHOWDIR(bbspath'Users')
user.=''
users=WORDS(userlist)
user.0=users
DO uli=1 TO users
  user.uli=WORD(userlist,uli)
  uscore=LASTPOS('_',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'@'LEFT(user.uli,uscore-1)
END
CALL QSORT(1,users,user)
DO uli=1 TO users
  uscore=POS('@',user.uli)
  IF uscore>0 THEN user.uli=SUBSTR(user.uli,uscore+1)'_'LEFT(user.uli,uscore-1)
END
ulynes.=''
ulynes.0=user.0%3
IF (user.0//3)>0 THEN ulynes.0=ulynes.0+1
DO i=1 TO ulynes.0
  ulynes.i=LEFT(user.i,25)
  DO j=1 TO 2
    k=i+j*ulynes.0
    IF k<=users THEN ulynes.i=ulynes.i' 'LEFT(user.k,25)
  END
END
CALL saveuserlist()
RETURN


showuserlist:
IF data.5='' THEN line='Here are the EMail names of your fellow users.'
ELSE line='   'WORDS(userlist) 'users. Use these names to address messages.'
SAY pen3||line||def
DO uli=1 TO ulynes.0
  SAY ulynes.uli
  IF uli//linesperpage=0 & uli<ulynes.0 THEN
    IF waiting2()=1 THEN RETURN
END
IF data.5~='' THEN CALL waiting()
RETURN


msgcount:
ARG countdir .
lastmess=0
totmsgs=0
unred=0
IF ~EXISTS(msgpath||countdir) THEN RETURN
IF STATEF(msgpath||countdir)=msg.countdir.1 THEN totmsgs=msg.countdir.0
ELSE
  DO
    totmsgs=WORDS(SHOWDIR(msgpath||countdir))
    msg.countdir.0=totmsgs
    msg.countdir.1=STATEF(msgpath||countdir)
  END
IF countdir>level | FIND(data.21,i)>0 THEN RETURN
lastread.countdir=WORD(data.22,countdir)
IF ~DATATYPE(lastread.countdir,'W') THEN lastread.countdir=0
lastmess=countcheck(bbspath'Numbers/LastMessage'countdir 0)
IF lastread.countdir<0 THEN RETURN
firstmess=countcheck(bbspath'Numbers/FirstMessage'countdir 0)
IF lastread.countdir<firstmess THEN lastread.countdir=firstmess-1
IF lastmess>0 THEN
  IF lastread.countdir>=0 THEN
    DO
      IF lastread.countdir<(firstmess-1) THEN lastread.countdir=firstmess-1
      unred=lastmess-lastread.countdir
      IF unred>totmsgs THEN unred=totmsgs
      cline=RIGHT(unred,6) 'unread of' RIGHT(lastmess,6)
      cline=cline 'messages in the 'CENTER(msg.countdir,20)' conference.'
      IF unred>0 | ~logonflag THEN SAY pen6||cline||def
    END
RETURN


counts:
SAY
SAY 'Working...'
SAY
temp=''
DO i=1 TO 4
  temp=temp||CENTER(copyright.i,75)||'0A'x
END
CALL SETCLIP('BBS_copyright',temp)
IF emailonline<0 THEN CALL countmail()
CALL bbsSTATS.rexx(name colorflag 0 emailonline grand grand2 files.0 WORDS(userlist))
SAY
CALL waiting2()
IF waitchar='Q' THEN RETURN
CALL showmarked(1)
CALL logonstats()
nonstop=0
CALL waiting()
RETURN


countmail:
SAY '   Counting online email...'
emailonline=0
DO ti=1 TO WORDS(userlist)
  emailonline=emailonline+WORDS(SHOWDIR(bbspath'Email/'WORD(userlist,ti)))
END
RETURN


hourly:
IF level=99 & nonstop~=1 THEN
  DO
    IF getinput(1 1 'Zero The Hourly Averages? (Ny) > ')='Y' THEN
      ADDRESS COMMAND 'C:Delete >*' bbspath'Numbers/Hourly/#?'
    CALL cleanline(1)
  END
CALL ShowHourly.rexx(name linesperpage colorflag nonstop)
RETURN


logonstats:
IF level=0 THEN RETURN
SAY bak2||name||def 'Last on' DATE('W',lastondate,'I') DATE(,lastondate,'I') lastontime
tempnum=countcheck(bbspath'Numbers/LastFile' 0)-lastbrowse
IF tempnum>files.0 THEN tempnum=files.0
line='of' RIGHT(countcheck(bbspath'Numbers/LastFile' 0),6) 'public files uploaded.'
IF tempnum>0 THEN SAY RIGHT(tempnum,6) '   new of' RIGHT(files.0,6) 'files online    'line
ELSE SAY '       No new' line
totmsg=0
grand=0
grand2=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  CALL msgcount(i)
  totmsg=totmsg+unred
  grand=grand+totmsgs
  grand2=grand2+lastmess
END
line=RIGHT(grand2,6) 'public messages written'
IF totmsg>0 THEN
  SAY RIGHT(totmsg,6) '   new of' line',' grand 'messages online.'
ELSE SAY '       No new of' line'.'
RETURN


readopen:
PARSE ARG fname
ok=OPEN(f,fname,'R')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for reading!'
SAY line
RETURN 0


writeopen:
PARSE ARG fname
CALL CLOSE(f)
ok=OPEN(f,fname,'W')
IF ok~=0 THEN RETURN 1
line=fname 'failed to open for writing!'
SAY line
RETURN 0


set_grand:
SAY 'Setting up public message conferences...'
grand=0
DO i=1 TO 99
  IF msg.i='' THEN ITERATE i
  msg.i.0=WORDS(SHOWDIR(msgpath||i,'F'))
  msg.i.1=STATEF(msgpath||i)
  grand=grand+msg.i.0
END
RETURN


SYNTAX:
FAILURE:
lin.1=pen7||ERRORTEXT(RC)||def
lin.2=SIGL-1     SOURCELINE(SIGL-1)
lin.3=SIGL pen7||SOURCELINE(SIGL)||def
lin.4=SIGL+1     SOURCELINE(SIGL+1)
DO er=1 TO 4
  SAY lin.er
END
IF newpassword='' THEN SIGNAL DONE2  /* no user logged on, quit quietly */
CALL CLOSE(f)
IF level>sysoplevel THEN
  DO
    junk=getinput(1 1 'ReStart: (Ny) > ')
    IF junk~='Y' THEN SIGNAL LOGOUT
  END
string=''
waitchar=''
IF data.1~='' & data.5~='' & data.20~='' THEN CALL savedata(0)
SIGNAL RESTART


BREAK_E:
CALL CLOSE(f)
SAY pen3'*** CTRL-E BREAK ***'def
waitchar=''
string=''
nonstop=0
rnonstop=0
brostop=0
i=999999
wi=999999
ni=-1
RETURN 0


BREAK_C:
CALL CLOSE(f)

LOGOUT:
LOGOUT2:
secs=TIME('E')
mins=secs%60
secs=TRUNC(secs//60)
IF secs<10 THEN secs='0'secs
SAY
SAY 'Public messages now online: 'RIGHT(comma(grand),9)
SAY 'Public    files now online: 'RIGHT(comma(files.0),9)
SAY
SAY 'Time used this call:' mins':'secs
SAY
arg=bbspath'BBS_TEXT/GOODBYE'
IF EXISTS(arg) THEN
  DO
    CALL DELAY(14)
    CALL readlines(arg 1)
    nonstop=1
    CALL seelines(0)
    nonstop=0
  END
SAY
IF bbsprefs.2 THEN CALL doGrin()
SAY
CALL bbsLOGOFF.baud(name level 0)

OUT:
data.18=winnings

OUT2:

DONE:

DONE2:
IF newfilesflag=1 THEN
  DO
    newfilesdate=DATE('S') TIME()
    lastbrowse=countcheck(bbspath'Numbers/LastFile' 0)
  END
IF clear_marked=1 THEN data.24=''
CALL saveData(0)
IF EXISTS(bbspath'EmailFiles/'name'/QUICKIN.lha') THEN
  ADDRESS AREXX bbsQUICKIN.rexx name level sysoplevel bbsprefs.6
IF sortuserflag=1 THEN
  DO
    CALL sortuserlist()
    IF SHOW('P','BBBBS') THEN
      DO
        CALL SETCLIP('BBS_mainusers')
        CALL SETCLIP('BBS_localusers',1)
      END
    sortuserflag=0
  END
IF sortalphaflag>0 | savefileflag>0 THEN
  DO
    IF savefileflag>0 THEN CALL savefilelist2()
    ELSE CALL savealphalist()
    IF SHOW('P','BBBBS') THEN CALL SETCLIP('BBS_localfiles',2)
  END
IF getinput(1 1 'Reset for next local user? (nY) > ')='N' THEN EXIT
clear_marked=0
data.=''
SIGNAL BIG_LOOP


checkclips:
IF GETCLIP('BBS_mainusers')~='' THEN
  DO
    CALL loaduserlist()
    CALL SETCLIP('BBS_mainusers')
  END
IF GETCLIP('BBS_mainfiles')~='' & GETCLIP('BBS_maint')='' THEN
  DO
    CALL SETCLIP('BBS_mainfiles')
    CALL loadfiles()
    CALL loadalpha()
  END
RETURN


checkalias:
addressee=''
IF alias.0=0 THEN RETURN 0
DO i=1 TO alias.0
 IF UPPER(alias.i)=UPPER(string) THEN
  DO
   addressee=realname.i
   LEAVE i
  END
END
IF addressee='' THEN RETURN 0
string=''
SAY pen3'Email to 'def||addressee
CALL editor('MAIL' addressee)
RETURN 0


Friends:
ch=''
aliasexclude='sysop bye off'
DO WHILE ch~='Q'
  SAY
  SAY pen3||LEFT('=',75,'=')def
  SAY CENTER('F R I E N D S - L I S T',75)
  SAY
  SAY CENTER('A L I A S   E D I T O R',75)
  SAY pen3||LEFT('=',75,'=')def
  SAY
  SAY '                           'pen3'W - 'def'What is the Friends List? '
  SAY '                           'pen3'A - 'def'Add an Alias '
  SAY '                           'pen3'D - 'def'Delete an Alias '
  SAY '                           'pen3'V - 'def'View my Aliases '
  SAY '                           'pen3'Q - 'def'Return to Main Menu'
  SAY
  ch=getinput(1 1 pen3'Enter Choice > 'def)
  SELECT
    WHEN ch='W' THEN CALL whatFriends()
    WHEN ch='A' THEN CALL addalias()
    WHEN ch='D' THEN CALL delalias()
    WHEN ch='V' THEN CALL viewalias()
    WHEN ch='Q' THEN CALL saveFriends()
    OTHERWISE SAY 'No such command'
  END
END
string=''
RETURN


saveFriends:
frn=bbspath'Friends/'name
IF alias.0<1 THEN
  DO
    CALL DELETE(frn)
    RETURN
  END
CALL OPEN(f,frn,'W')
DO i=1 TO alias.0
  CALL WRITELN(f,alias.i'  'realname.i)
END
CALL CLOSE(f)
RETURN


whatFriends:
CALL readlines(bbspath'Information/BBBBS.Friends' 1)
CALL cleanline(0)
CALL seelines(0)
IF waitchar~='Q' THEN CALL waiting()
nonstop=0
RETURN


addalias:
match=0
username=getinput(1 0 pen3'Enter Users Email Name > 'def)
username=cleanstring(1':'username)
IF username='' THEN RETURN
IF FIND(userlist,username)=0 THEN
 DO
  SAY 'Username not found'
  RETURN
 END
newalias=getinput(1 0 pen3'Enter an Alias for'def' 'username def'> ')
IF newalias='' THEN RETURN
IF alias.0>0 THEN
  DO i=1 TO alias.0
   IF UPPER(alias.i)=UPPER(newalias) THEN match=1
  END
IF FIND(aliasexclude,newalias)>0 THEN match=2
IF match=0 THEN
  DO
   alias.0=alias.0+1
   num=alias.0
   alias.num=newalias
   realname.num=username
   SAY alias.num 'alias as ' realname.num 'added'
  END
ELSE IF match=1 THEN SAY 'Alias 'newalias' already exists'
ELSE SAY newalias ' is a reserved name'
RETURN


delalias:
match=0
dalias=getinput(1 0 pen3'Enter Alias to Delete > 'def)
dalias=UPPER(WORD(dalias,1))
IF alias.0>0 THEN
  DO i=1 TO alias.0
   IF UPPER(alias.i)=UPPER(dalias) THEN
    DO
     match=1
     num=i
     LEAVE i
    END
  END
IF match=1 THEN
 DO
  IF getinput(1 1 'Really Delete 'dalias'? (Ny) > ')='Y' THEN
   DO
    DO i=num TO alias.0
     j=i+1
     alias.i=alias.j
     realname.i=realname.j
    END
    alias.0=alias.0-1
   END
 END
ELSE SAY dalias' not Found.'
RETURN


viewalias:
IF alias.0>0 THEN
DO i=1 TO alias.0
 SAY RIGHT(alias.i,20) 'is' realname.i
END
ELSE SAY 'No Aliases assigned'
RETURN


/* bbsLOCAL.rexx */


/*  Userfile Data definitions */

 1 name
 2 address
 3 city state country zip
 4 telephone
 5 password
 6 protocol
 7 lines per page
 8 Preferences: MENUS COLOR STREET PHONE etc. On list=YES, ON or PUBLIC.
 9 Computer model
10 interests        ! SYSOP edit only below this line !
11 nn minutes n more times today  (typically 60 mins 3 times/day).
12 first date on.  timestamp  Birthday: birthday
13 last  date on BBS in 'S' form for rexx DATE().
14 uploaded files bytes lastdate
15 downloaded files bytes lastdate
16 lastfilebrowsed lastfilelistdate lastfilelisttime
17 ul:dl_ratio  total_email_written  last_email_read_(sysop only)
18 winnings
19 total time on this BBS in hours minutes calls
20 level
21 exclude dirs by name (conferences by number), separated by spaces.
22 oldest messages read
23 total msgs written per conference
24 Marked message list  msgdirnum/msgnum
25 filenumbers to download (temporary)
26 QUICK exclude list
27 Call Back Verify Number(s)

/* end data defines */